1 TADPOLE and BSWiMS

1.0.1 Loading the libraries

library("FRESA.CAD")
library(readxl)
library(igraph)
op <- par(no.readonly = TRUE)
pander::panderOptions('digits', 3)
pander::panderOptions('table.split.table', 400)
pander::panderOptions('keep.trailing.zeros',TRUE)

1.1 The data set

TADPOLE_D1_D2 <- read.csv("~/GitHub/BSWiMS/Data/TADPOLE/TADPOLE_D1_D2.csv")
TADPOLE_D1_D2_Dict <- read.csv("~/GitHub/BSWiMS/Data/TADPOLE/TADPOLE_D1_D2_Dict.csv")
TADPOLE_D1_D2_Dict_LR <- as.data.frame(read_excel("~/GitHub/BSWiMS/Data/TADPOLE/TADPOLE_D1_D2_Dict_LR.xlsx",sheet = "LeftRightFeatures"))


rownames(TADPOLE_D1_D2_Dict) <- TADPOLE_D1_D2_Dict$FLDNAME

1.2 Conditioning the data


# mm3 to mm
isVolume <- c("Ventricles","Hippocampus","WholeBrain","Entorhinal","Fusiform","MidTemp","ICV",
              TADPOLE_D1_D2_Dict$FLDNAME[str_detect(TADPOLE_D1_D2_Dict$TEXT,"Volume")]
              )


#TADPOLE_D1_D2[,isVolume] <- apply(TADPOLE_D1_D2[,isVolume],2,'^',(1/3))
TADPOLE_D1_D2[,isVolume] <- TADPOLE_D1_D2[,isVolume]^(1/3)

# mm2 to mm
isArea <- TADPOLE_D1_D2_Dict$FLDNAME[str_detect(TADPOLE_D1_D2_Dict$TEXT,"Area")]
TADPOLE_D1_D2[,isArea] <- sqrt(TADPOLE_D1_D2[,isArea])

# Get only cross sectional measurements
FreeSurfersetCross <- str_detect(colnames(TADPOLE_D1_D2),"UCSFFSX")

# The subset of baseline measurements
baselineTadpole <- subset(TADPOLE_D1_D2,VISCODE=="bl")
table(baselineTadpole$DX)
                   Dementia Dementia to MCI             MCI MCI to Dementia 
          7             336               1             864               5 
  MCI to NL              NL       NL to MCI 
          2             521               1 

rownames(baselineTadpole) <- baselineTadpole$PTID


validBaselineTadpole <- cbind(DX=baselineTadpole$DX,
                                 AGE=baselineTadpole$AGE,
                                 Gender=1*(baselineTadpole$PTGENDER=="Female"),
                                 ADAS11=baselineTadpole$ADAS11,
                                 ADAS13=baselineTadpole$ADAS13,
                                 MMSE=baselineTadpole$MMSE,
                                 RAVLT_immediate=baselineTadpole$RAVLT_immediate,
                                 RAVLT_learning=baselineTadpole$RAVLT_learning,
                                 RAVLT_forgetting=baselineTadpole$RAVLT_forgetting,
                                 RAVLT_perc_forgetting=baselineTadpole$RAVLT_perc_forgetting,
                                 FAQ=baselineTadpole$FAQ,
                                 Ventricles=baselineTadpole$Ventricles,
                                 Hippocampus=baselineTadpole$Hippocampus,
                                 WholeBrain=baselineTadpole$WholeBrain,
                                 Entorhinal=baselineTadpole$Entorhinal,
                                 Fusiform=baselineTadpole$Fusiform,
                                 MidTemp=baselineTadpole$MidTemp,
                                 ICV=baselineTadpole$ICV,
                                 baselineTadpole[,FreeSurfersetCross])


LeftFields <- TADPOLE_D1_D2_Dict_LR$LFN
names(LeftFields) <- LeftFields
LeftFields <- LeftFields[LeftFields %in% colnames(validBaselineTadpole)]
RightFields <- TADPOLE_D1_D2_Dict_LR$RFN
names(RightFields) <- RightFields
RightFields <- RightFields[RightFields %in% colnames(validBaselineTadpole)]

## Normalize to ICV
validBaselineTadpole$Ventricles=validBaselineTadpole$Ventricles/validBaselineTadpole$ICV
validBaselineTadpole$Hippocampus=validBaselineTadpole$Hippocampus/validBaselineTadpole$ICV
validBaselineTadpole$WholeBrain=validBaselineTadpole$WholeBrain/validBaselineTadpole$ICV
validBaselineTadpole$Entorhinal=validBaselineTadpole$Entorhinal/validBaselineTadpole$ICV
validBaselineTadpole$Fusiform=validBaselineTadpole$Fusiform/validBaselineTadpole$ICV
validBaselineTadpole$MidTemp=validBaselineTadpole$MidTemp/validBaselineTadpole$ICV

leftData <- validBaselineTadpole[,LeftFields]/validBaselineTadpole$ICV
RightData <- validBaselineTadpole[,RightFields]/validBaselineTadpole$ICV

## get mean and relative difference 
meanLeftRight <- (leftData + RightData)/2
difLeftRight <- abs(leftData - RightData)
reldifLeftRight <- difLeftRight/meanLeftRight
colnames(meanLeftRight) <- paste("M",colnames(meanLeftRight),sep="_")
colnames(difLeftRight) <- paste("D",colnames(difLeftRight),sep="_")
colnames(reldifLeftRight) <- paste("RD",colnames(reldifLeftRight),sep="_")


validBaselineTadpole <- validBaselineTadpole[,!(colnames(validBaselineTadpole) %in% 
                                               c(LeftFields,RightFields))]
validBaselineTadpole <- cbind(validBaselineTadpole,meanLeftRight,reldifLeftRight)

## Remove columns with too many NA more than %15 of NA
nacount <- apply(is.na(validBaselineTadpole),2,sum)/nrow(validBaselineTadpole) < 0.15
diagnose <- validBaselineTadpole$DX
pander::pander(table(diagnose))
  Dementia Dementia to MCI MCI MCI to Dementia MCI to NL NL NL to MCI
7 336 1 864 5 2 521 1
validBaselineTadpole <- validBaselineTadpole[,nacount]
## Remove character columns
ischar <- sapply(validBaselineTadpole,class) == "character"
validBaselineTadpole <- validBaselineTadpole[,!ischar]
## Place back diagnose
validBaselineTadpole$DX <- diagnose


validBaselineTadpole <- validBaselineTadpole[complete.cases(validBaselineTadpole),]
ischar <- sapply(validBaselineTadpole,class) == "character"
validBaselineTadpole[,!ischar] <- sapply(validBaselineTadpole[,!ischar],as.numeric)

colnames(validBaselineTadpole) <- str_remove_all(colnames(validBaselineTadpole),"_UCSFFSX_11_02_15_UCSFFSX51_08_01_16")
colnames(validBaselineTadpole) <- str_replace_all(colnames(validBaselineTadpole)," ","_")
validBaselineTadpole$LONISID <- NULL
validBaselineTadpole$IMAGEUID <- NULL
validBaselineTadpole$LONIUID <- NULL

diagnose <- as.character(validBaselineTadpole$DX)
validBaselineTadpole$DX <- diagnose
pander::pander(table(validBaselineTadpole$DX))
Dementia Dementia to MCI MCI MCI to Dementia MCI to NL NL NL to MCI
244 1 711 2 2 452 1


validDX <- c("NL","MCI","Dementia")

validBaselineTadpole <- validBaselineTadpole[validBaselineTadpole$DX %in% validDX,]
validBaselineTadpole$DX <- as.factor(validBaselineTadpole$DX)
pander::pander(table(validBaselineTadpole$DX))
Dementia MCI NL
244 711 452

1.3 Get the Time To Event on MCI Subjects


subjectsID <- rownames(validBaselineTadpole)
visitsID <- unique(TADPOLE_D1_D2$VISCODE)
baseDx <- TADPOLE_D1_D2[TADPOLE_D1_D2$VISCODE=="bl",c("PTID","DX","EXAMDATE")]
rownames(baseDx) <- baseDx$PTID 
baseDx <- baseDx[subjectsID,]
lastDx <- baseDx
toDementia <- baseDx
table(lastDx$DX)

Dementia MCI NL 244 711 452

hasDementia <- lastDx$PTID[str_detect(lastDx$DX,"Dementia")]


for (vid in visitsID)
{
  DxValue <- TADPOLE_D1_D2[TADPOLE_D1_D2$VISCODE==vid,c("PTID","DX","EXAMDATE")]
  rownames(DxValue) <- DxValue$PTID 
  DxValue <- DxValue[DxValue$PTID %in% subjectsID,]
  noDX <- DxValue$PTID[nchar(DxValue$DX) < 1]
  print(length(noDX))
  DxValue[noDX,] <- lastDx[noDX,]
  inLast <- lastDx$PTID[lastDx$PTID %in% DxValue$PTID]
  print(length(inLast))
  lastDx[inLast,] <- DxValue[inLast,]
  noDementia <- !(toDementia$PTID %in% hasDementia)
  toDementia[noDementia,] <- lastDx[noDementia,]
  hasDementia <- unique(c(hasDementia,lastDx$PTID[str_detect(lastDx$DX,"Dementia")]))
}

[1] 0 [1] 1407 [1] 2 [1] 1320 [1] 6 [1] 1212 [1] 23 [1] 1090 [1] 802 [1] 1054 [1] 29 [1] 706 [1] 20 [1] 212 [1] 14 [1] 167 [1] 32 [1] 551 [1] 25 [1] 297 [1] 18 [1] 130 [1] 665 [1] 665 [1] 112 [1] 112 [1] 176 [1] 176 [1] 177 [1] 177 [1] 624 [1] 624 [1] 251 [1] 251 [1] 159 [1] 159 [1] 7 [1] 7 [1] 17 [1] 99 [1] 9 [1] 63 [1] 1 [1] 1

table(lastDx$DX)
   Dementia Dementia to MCI             MCI MCI to Dementia       MCI to NL 
        426               2             460              80               7 
         NL  NL to Dementia       NL to MCI 
        405               1              26 
baseMCI <-baseDx$PTID[baseDx$DX == "MCI"]
lastDementia <- lastDx$PTID[str_detect(lastDx$DX,"Dementia")]
lastDementia2 <- toDementia$PTID[str_detect(toDementia$DX,"Dementia")]
lastNL <- lastDx$PTID[str_detect(lastDx$DX,"NL")]

MCIatBaseline <- baseDx[baseMCI,]
MCIatEvent <- toDementia[baseMCI,]
MCIatLast <- lastDx[baseMCI,]

MCIconverters <- MCIatBaseline[baseMCI %in% lastDementia,]
MCI_No_converters <- MCIatBaseline[!(baseMCI %in% MCIconverters$PTID),]
MCIconverters$TimeToEvent <- (as.Date(toDementia[MCIconverters$PTID,"EXAMDATE"]) 
                                   - as.Date(MCIconverters$EXAMDATE))

sum(MCIconverters$TimeToEvent ==0)

[1] 0



MCIconverters$AtEventDX <- MCIatEvent[MCIconverters$PTID,"DX"]
MCIconverters$LastDX <- MCIatLast[MCIconverters$PTID,"DX"]

MCI_No_converters$TimeToEvent <- (as.Date(lastDx[MCI_No_converters$PTID,"EXAMDATE"]) 
                                   - as.Date(MCI_No_converters$EXAMDATE))

MCI_No_converters$LastDX <- MCIatLast[MCI_No_converters$PTID,"DX"]

MCI_No_converters <- subset(MCI_No_converters,TimeToEvent > 0)

1.3.1 Correlation Matrix Data

The heat map of the testing set.


cormat <- cor(validBaselineTadpole[,colnames(validBaselineTadpole) != "DX"],method="spearman")
diag(cormat) <- 0;
corrmax <- apply(cormat,2,max)
whomax <- colnames(cormat)[corrmax>0.75]
gplots::heatmap.2(abs(cormat[whomax,whomax]),
                  trace = "none",
                  scale = "none",
                  mar = c(10,10),
                  col=rev(heat.colors(5)),
                  main = "Baseline TADPOLE Correlation",
                  cexRow = 0.5,
                  cexCol = 0.5,
                  key.title=NA,
                  key.xlab="Spearman Correlation",
                  xlab="Feature", ylab="Feature")

par(op)

2 Predicting ADAS13

Here we will diagnose ADAS13

2.1 Training and testing sets


TrainFraction <- 0.5;

TADPOLECrossMRI <- validBaselineTadpole
summary(TADPOLECrossMRI$ADAS13)

Min. 1st Qu. Median Mean 3rd Qu. Max. 0.00 9.00 14.67 16.37 22.00 51.00


TADPOLECrossMRI$ADAS11 <- NULL
TADPOLECrossMRI$MMSE <- NULL
TADPOLECrossMRI$RAVLT_immediate <- NULL
TADPOLECrossMRI$RAVLT_learning <- NULL
TADPOLECrossMRI$RAVLT_perc_forgetting <- NULL
TADPOLECrossMRI$RAVLT_forgetting <- NULL
TADPOLECrossMRI$FAQ <- NULL
TADPOLECrossMRI$DX <- NULL

trainSet <- sample(nrow(TADPOLECrossMRI),nrow(TADPOLECrossMRI)*TrainFraction)

TADPOLECrossMRITrain <- TADPOLECrossMRI[trainSet,]
TADPOLECrossMRITest <- TADPOLECrossMRI[-trainSet,]

2.1.1 Learning ADAS13

bml <- BSWiMS.model(ADAS13~.,TADPOLECrossMRITrain,maxTrainModelSize=50,NumberofRepeats = 20)

[+-++-+-++-++-+-+-+-++-++-++-++-++-+-+-++-+-+-++-++-]…

pander::pander(bml$bagging$Jaccard.SM)

0.307

fs <- bml$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bml)
pander::pander(sm$coefficients)
  Estimate lower mean upper u.MSE r.MSE model.MSE NeRI F.pvalue t.pvalue Sign.pvalue Wilcox.pvalue Frequency
M_ST24CV -310.374 -354.175 -310.374 -266.5736 69.6 60.8 48.4 0.18453 0.00e+00 8.90e-17 5.24e-07 2.69e-09 0.55
M_ST24TA -352.914 -447.773 -352.914 -258.0546 65.1 48.4 44.9 0.05832 1.53e-13 3.00e-05 5.62e-02 4.06e-03 1.00
M_ST24SA 85.592 61.655 85.592 109.5299 95.8 51.9 48.4 0.08729 1.21e-12 8.38e-06 9.44e-03 1.23e-03 0.55
M_ST51TA 829.670 578.616 829.670 1080.7246 92.7 48.6 45.8 0.05832 4.67e-11 5.82e-04 5.83e-02 2.30e-02 0.95
M_ST31TA -583.062 -794.625 -583.062 -371.4987 80.8 49.1 47.0 0.06143 3.30e-08 1.28e-05 3.42e-02 3.67e-03 0.55
M_ST31CV -80.805 -113.204 -80.805 -48.4049 78.5 46.5 44.9 0.04505 5.09e-07 2.69e-03 1.02e-01 4.26e-02 0.90
M_ST49TA 121.401 72.711 121.401 170.0912 92.7 49.1 47.4 0.06970 5.12e-07 1.18e-02 3.50e-02 5.37e-02 0.10
RD_ST32TA 15.084 8.937 15.084 21.2315 87.2 46.4 44.9 0.02333 7.57e-07 1.98e-02 2.66e-01 1.66e-01 1.00
Hippocampus -107.597 -152.481 -107.597 -62.7136 69.6 46.3 44.9 0.11010 1.31e-06 4.17e-06 1.60e-03 4.48e-04 1.00
M_ST55CV -100.224 -143.349 -100.224 -57.1001 85.1 48.5 47.1 0.03820 2.62e-06 9.38e-03 1.38e-01 5.56e-02 0.70
M_ST56TA -84.415 -121.210 -84.415 -47.6190 86.7 48.0 46.7 0.01991 3.45e-06 3.14e-02 3.11e-01 1.69e-01 0.10
M_ST129TS 659.579 368.769 659.579 950.3892 95.7 49.0 47.6 0.05548 4.39e-06 3.67e-03 6.35e-02 3.53e-02 0.55
M_ST15TA -337.926 -488.359 -337.926 -187.4931 85.4 46.7 45.4 0.05349 5.34e-06 1.90e-03 6.68e-02 3.71e-02 0.50
ST10CV -0.154 -0.224 -0.154 -0.0842 97.5 46.9 45.6 0.07145 7.68e-06 4.43e-04 2.41e-02 1.32e-02 0.65
Gender -0.813 -1.189 -0.813 -0.4370 96.6 48.7 47.5 0.07783 1.13e-05 1.44e-03 1.99e-02 1.64e-02 0.35
M_ST51CV 30.311 15.650 30.311 44.9730 94.0 49.0 47.8 0.05263 2.54e-05 5.54e-02 7.50e-02 8.52e-02 0.25
M_ST39SA 5.474 2.802 5.474 8.1453 96.7 46.5 45.5 0.03983 2.97e-05 5.62e-02 1.36e-01 9.92e-02 0.20
M_ST56TS 234.494 115.922 234.494 353.0649 96.1 48.6 47.6 0.06780 5.31e-05 3.85e-04 2.82e-02 1.11e-02 0.15
M_ST55SA -12.775 -19.397 -12.775 -6.1540 94.9 46.6 45.6 0.04453 7.79e-05 1.14e-02 1.06e-01 8.72e-02 0.65
M_ST39CV 28.531 13.504 28.531 43.5576 92.9 47.6 46.7 0.02845 9.91e-05 6.86e-02 1.86e-01 1.29e-01 0.30
M_ST30SV 43.320 20.477 43.320 66.1625 73.3 46.0 45.1 0.06842 1.01e-04 8.17e-03 3.27e-02 2.34e-02 1.00
RD_ST35TA 6.856 3.215 6.856 10.4980 95.3 49.6 48.6 0.04315 1.12e-04 6.78e-02 1.27e-01 1.76e-01 0.30
RD_ST56TA 23.495 10.946 23.495 36.0441 94.6 46.1 45.2 0.03954 1.22e-04 7.62e-02 1.32e-01 1.71e-01 1.00
M_ST31SA -6.608 -10.142 -6.608 -3.0745 92.4 48.6 47.7 0.01920 1.24e-04 1.13e-02 2.24e-01 9.99e-02 0.20
M_ST40CV -58.917 -90.490 -58.917 -27.3432 72.7 49.3 48.3 0.01027 1.27e-04 1.94e-01 4.33e-01 2.74e-01 0.45
M_ST17SV 40.808 18.663 40.808 62.9521 97.4 46.1 45.3 0.06950 1.52e-04 2.79e-05 3.09e-02 2.31e-03 0.70
RD_ST31TA 13.935 6.314 13.935 21.5558 90.0 45.7 44.9 0.04083 1.69e-04 8.58e-03 1.35e-01 8.65e-02 1.00
RD_ST40CV 7.147 3.200 7.147 11.0945 92.6 46.6 45.8 0.10633 1.94e-04 7.16e-04 2.09e-03 4.01e-03 0.40
RD_ST57TA 16.858 7.530 16.858 26.1869 92.5 45.8 45.0 0.08065 1.99e-04 1.62e-02 1.67e-02 3.98e-02 1.00
RD_ST40TA 3.577 1.459 3.577 5.6958 88.3 49.1 48.4 0.04339 4.67e-04 1.17e-01 1.31e-01 1.69e-01 0.20
M_ST65SV 28.707 11.663 28.707 45.7502 95.8 46.0 45.3 0.05263 4.81e-04 4.17e-02 7.59e-02 8.55e-02 0.25
M_ST32CV -22.114 -35.271 -22.114 -8.9575 73.3 46.8 46.1 0.02987 4.93e-04 5.20e-03 2.08e-01 5.79e-02 0.25
RD_ST26TA 5.896 2.355 5.896 9.4370 90.0 48.8 48.1 0.02906 5.50e-04 5.47e-03 2.11e-01 5.39e-02 0.35
M_ST23CV 24.683 9.497 24.683 39.8702 96.6 47.8 47.1 0.00284 7.22e-04 2.88e-01 5.66e-01 3.72e-01 0.20
Ventricles -4.673 -7.626 -4.673 -1.7201 87.2 45.3 44.7 0.01849 9.62e-04 5.27e-02 2.92e-01 1.52e-01 0.30
M_ST34TA -40.225 -66.960 -40.225 -13.4898 86.0 49.7 49.1 0.03414 1.59e-03 1.79e-02 1.93e-01 7.69e-02 0.10
WholeBrain 5.211 1.429 5.211 8.9934 83.3 48.7 48.2 0.03414 3.46e-03 1.01e-01 1.92e-01 1.77e-01 0.10
M_ST38TA 47.270 9.605 47.270 84.9354 91.6 46.9 46.4 -0.00427 6.95e-03 6.78e-01 6.18e-01 6.19e-01 0.10
M_ST43TS 156.038 30.546 156.038 281.5294 97.5 45.6 45.2 0.04523 7.40e-03 6.38e-02 1.14e-01 1.32e-01 0.25
pander::pander(bml$univariate[bml$selectedfeatures,])
  Name RName ZUni
M_ST24TA M_ST24TA M_ST24TA Inf
RD_ST32TA RD_ST32TA RD_ST32TA Inf
M_ST30SV M_ST30SV M_ST30SV Inf
Ventricles Ventricles Ventricles Inf
Hippocampus Hippocampus Hippocampus Inf
M_ST18SV M_ST18SV M_ST18SV 2.11
RD_ST56TA RD_ST56TA RD_ST56TA 4.85
RD_ST57TA RD_ST57TA RD_ST57TA 6.27
RD_ST31TA RD_ST31TA RD_ST31TA 7.63
M_ST43TS M_ST43TS M_ST43TS 1.48
M_ST31CV M_ST31CV M_ST31CV Inf
M_ST65SV M_ST65SV M_ST65SV 3.82
M_ST55SA M_ST55SA M_ST55SA 4.61
M_ST32CV M_ST32CV M_ST32CV Inf
M_ST60CV M_ST60CV M_ST60CV Inf
M_ST39SA M_ST39SA M_ST39SA 2.86
M_ST17SV M_ST17SV M_ST17SV 1.76
M_ST51TA M_ST51TA M_ST51TA 6.10
M_ST15TA M_ST15TA M_ST15TA Inf
M_ST24CV M_ST24CV M_ST24CV Inf
M_ST55CV M_ST55CV M_ST55CV Inf
RD_ST40CV RD_ST40CV RD_ST40CV 6.17
WholeBrain WholeBrain WholeBrain Inf
ST10CV ST10CV ST10CV 1.54
M_ST50TA M_ST50TA M_ST50TA 7.20
M_ST24SA M_ST24SA M_ST24SA 3.75
M_ST40CV M_ST40CV M_ST40CV Inf
M_ST39CV M_ST39CV M_ST39CV 5.98
M_ST38TA M_ST38TA M_ST38TA 6.77
M_ST129TS M_ST129TS M_ST129TS 3.89
M_ST51CV M_ST51CV M_ST51CV 5.27
RD_ST26TA RD_ST26TA RD_ST26TA 7.62
M_ST23CV M_ST23CV M_ST23CV 2.91
M_ST56TS M_ST56TS M_ST56TS 3.45
M_ST56TA M_ST56TA M_ST56TA Inf
RD_ST35TA RD_ST35TA RD_ST35TA 4.22
M_ST31TA M_ST31TA M_ST31TA Inf
RD_ST32CV RD_ST32CV RD_ST32CV 5.50
RD_ST40TA RD_ST40TA RD_ST40TA Inf
M_ST40TS M_ST40TS M_ST40TS 1.22
M_ST31SA M_ST31SA M_ST31SA 6.30
M_ST40TA M_ST40TA M_ST40TA Inf
Gender Gender Gender 2.98
M_ST49TA M_ST49TA M_ST49TA 6.15
M_ST15CV M_ST15CV M_ST15CV 6.97
M_ST34TA M_ST34TA M_ST34TA Inf
M_ST35SA M_ST35SA M_ST35SA 2.11
M_ST35CV M_ST35CV M_ST35CV 7.30

prreg <- predictionStats_regression(cbind(TADPOLECrossMRITest$ADAS13,predict(bml,TADPOLECrossMRITest)),"ADAS13")

ADAS13

pander::pander(prreg)
  • corci:

    cor    
    0.705 0.666 0.74
  • biasci: 0.803, 0.330 and 1.276

  • RMSEci: 6.44, 6.13 and 6.80

  • spearmanci:

    50% 2.5% 97.5%
    0.627 0.576 0.673
  • MAEci:

    50% 2.5% 97.5%
    5.13 4.84 5.42
  • pearson:

    Pearson’s product-moment correlation: predictions[, 1] and predictions[, 2]
    Test statistic df P value Alternative hypothesis cor
    26.3 702 9.41e-107 * * * two.sided 0.705
par(op)

2.1.2 The formula network

cmax <- apply(bml$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.250])
cmax <- cmax[cnames]

adma <- bml$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=5*E(gr)$weight,
     vertex.size=20*cmax,
     vertex.label.cex=0.5,
     vertex.label.dist=0,
     main="ADAS13 Feature Association")

par(op)

2.1.3 The ADAS13 table


clusterFeatures <- fc$names
sm$coefficients$Rx2 <- (sm$coefficients$r.MSE-sm$coefficients$model.MSE)/sm$coefficients$r.MSE

tableADAS13 <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "mean",
                                     "upper",
                                     "model.MSE",
                                     "Rx2",
                                     "F.pvalue",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableADAS13$Cluster <- nugget[rownames(tableADAS13)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableADAS13$Description <- description[rownames(tableADAS13)]
pander::pander(tableADAS13)
  Estimate lower mean upper model.MSE Rx2 F.pvalue Frequency Cluster Description
M_ST24TA -352.914 -447.773 -352.914 -258.0546 44.9 0.07294 1.53e-13 1.00 1 Cortical Thickness Average of LeftEntorhinal
RD_ST32TA 15.084 8.937 15.084 21.2315 44.9 0.03246 7.57e-07 1.00 1 Cortical Thickness Average of LeftInferiorTemporal
M_ST30SV 43.320 20.477 43.320 66.1625 45.1 0.01966 1.01e-04 1.00 1 Volume (WM Parcellation) of LeftInferiorLateralVentricle
Ventricles -4.673 -7.626 -4.673 -1.7201 44.7 0.01361 9.62e-04 0.30 1 NA
Hippocampus -107.597 -152.481 -107.597 -62.7136 44.9 0.03097 1.31e-06 1.00 1 NA
RD_ST56TA 23.495 10.946 23.495 36.0441 45.2 0.01907 1.22e-04 1.00 1 Cortical Thickness Average of LeftSuperiorFrontal
RD_ST57TA 16.858 7.530 16.858 26.1869 45.0 0.01773 1.99e-04 1.00 1 Cortical Thickness Average of LeftSuperiorParietal
RD_ST31TA 13.935 6.314 13.935 21.5558 44.9 0.01815 1.69e-04 1.00 1 Cortical Thickness Average of LeftInferiorParietal
M_ST43TS 156.038 30.546 156.038 281.5294 45.2 0.00848 7.40e-03 0.25 1 Cortical Thickness Standard Deviation of LeftParacentral
M_ST31CV -80.805 -113.204 -80.805 -48.4049 44.9 0.03371 5.09e-07 0.90 1 Volume (Cortical Parcellation) of LeftInferiorParietal
M_ST65SV 28.707 11.663 28.707 45.7502 45.3 0.01557 4.81e-04 0.25 1 Volume (WM Parcellation) of LeftVentralDC
M_ST55SA -12.775 -19.397 -12.775 -6.1540 45.6 0.02029 7.79e-05 0.65 1 Surface Area of LeftRostralMiddleFrontal
M_ST32CV -22.114 -35.271 -22.114 -8.9575 46.1 0.01552 4.93e-04 0.25 2 Volume (Cortical Parcellation) of LeftInferiorTemporal
M_ST17SV 40.808 18.663 40.808 62.9521 45.3 0.01845 1.52e-04 0.70 1 Volume (WM Parcellation) of LeftCerebellumCortex
M_ST51TA 829.670 578.616 829.670 1080.7246 45.8 0.05798 4.67e-11 0.95 2 Cortical Thickness Average of LeftPrecentral
M_ST15TA -337.926 -488.359 -337.926 -187.4931 45.4 0.02721 5.34e-06 0.50 1 Cortical Thickness Average of LeftCaudalMiddleFrontal
M_ST24CV -310.374 -354.175 -310.374 -266.5736 48.4 0.20433 0.00e+00 0.55 2 Volume (Cortical Parcellation) of LeftEntorhinal
M_ST55CV -100.224 -143.349 -100.224 -57.1001 47.1 0.02943 2.62e-06 0.70 2 Volume (Cortical Parcellation) of LeftRostralMiddleFrontal
RD_ST40CV 7.147 3.200 7.147 11.0945 45.8 0.01782 1.94e-04 0.40 2 Volume (Cortical Parcellation) of LeftMiddleTemporal
ST10CV -0.154 -0.224 -0.154 -0.0842 45.6 0.02665 7.68e-06 0.65 2 Volume (Cortical Parcellation) of Icv
M_ST24SA 85.592 61.655 85.592 109.5299 48.4 0.06746 1.21e-12 0.55 2 Surface Area of LeftEntorhinal
M_ST40CV -58.917 -90.490 -58.917 -27.3432 48.3 0.01922 1.27e-04 0.45 2 Volume (Cortical Parcellation) of LeftMiddleTemporal
M_ST39CV 28.531 13.504 28.531 43.5576 46.7 0.01954 9.91e-05 0.30 1 Volume (Cortical Parcellation) of LeftMedialOrbitofrontal
M_ST129TS 659.579 368.769 659.579 950.3892 47.6 0.02833 4.39e-06 0.55 2 Cortical Thickness Standard Deviation of LeftInsula
M_ST51CV 30.311 15.650 30.311 44.9730 47.8 0.02324 2.54e-05 0.25 2 Volume (Cortical Parcellation) of LeftPrecentral
RD_ST26TA 5.896 2.355 5.896 9.4370 48.1 0.01513 5.50e-04 0.35 2 Cortical Thickness Average of LeftFusiform
RD_ST35TA 6.856 3.215 6.856 10.4980 48.6 0.01919 1.12e-04 0.30 2 Cortical Thickness Average of LeftLateralOccipital
M_ST31TA -583.062 -794.625 -583.062 -371.4987 47.0 0.04105 3.30e-08 0.55 2 Cortical Thickness Average of LeftInferiorParietal
Gender -0.813 -1.189 -0.813 -0.4370 47.5 0.02538 1.13e-05 0.35 2 NA

2.1.4 Decorrelating training and testing sets



TADPOLECrossMRITrainD <- GDSTMDecorrelation(TADPOLECrossMRITrain,Outcome="ADAS13",
                                        thr=0.6,
                                        type="RLM",
                                        method="spearman",
                                        verbose = TRUE)
#> 
#>  Included: 197 , Uni p: 0.01145966 To Outcome: 122 , Base: 6 , In Included: 6 , Base Cor: 18 
#> 1 , Top: 36 < 0.6 >( 2 )[ 1 : 0 : 0.594 ]( 35 , 88 , 0 ),<>Tot Used: 123 , Added: 88 , Zero Std: 0 , Max Cor: 0.9484249 
#> 2 , Top: 25 < 0.6 >( 1 )[ 1 : 0 : 0.594 ]( 24 , 35 , 35 ),<>Tot Used: 147 , Added: 35 , Zero Std: 0 , Max Cor: 0.8993252 
#> 3 , Top: 19 < 0.6 >( 2 )[ 1 : 0 : 0 ]( 16 , 18 , 54 ),<>Tot Used: 151 , Added: 18 , Zero Std: 0 , Max Cor: 0.8960537 
#> 4 , Top: 5 < 0.6 >[ TRUE ]( 1 )[ 1 : 0 : 0 ]( 5 , 5 , 65 ),<>Tot Used: 151 , Added: 5 , Zero Std: 0 , Max Cor: 0.6139909 
#> 5 , Top: 2 < 0.6 >[ FALSE ]( 1 )[ 1 : 0 : 0.6 ]( 2 , 2 , 67 ),<>Tot Used: 151 , Added: 2 , Zero Std: 0 , Max Cor: 0.6288532 
#> 6 , Top: 1 < 0.6 >( 1 )[ 1 : 0 : 0.6 ]( 1 , 1 , 68 ),<>Tot Used: 151 , Added: 1 , Zero Std: 0 , Max Cor: 0.5981779 
#> [ 7 ], 0.5981779 . Cor to Base: 97 , ABase: 68
TADPOLECrossMRITestD <-  predictDecorrelate(TADPOLECrossMRITrainD,TADPOLECrossMRITest)

2.2 Decorrelated

bmlD <- BSWiMS.model(ADAS13~.,TADPOLECrossMRITrainD,maxTrainModelSize=50,NumberofRepeats = 20)

[+-+–+-+-+-+-++-+-+-+-+-+-+-+-+-++-+-+-+-+-]..

pander::pander(bmlD$bagging$Jaccard.SM)

0.549

fs <- bmlD$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bmlD)
pander::pander(sm$coefficients)
  Estimate lower mean upper u.MSE r.MSE model.MSE NeRI F.pvalue t.pvalue Sign.pvalue Wilcox.pvalue Frequency
Ba_Hippocampus -415.962 -4.75e+02 -415.962 -357.2610 69.6 60.9 45.0 0.22248 0.00e+00 1.78e-26 1.78e-09 9.21e-14 1.00
De_M_ST24TA -699.354 -8.04e+02 -699.354 -594.8917 90.2 50.0 45.0 0.06785 0.00e+00 1.51e-05 3.44e-02 2.61e-03 1.00
Ba_M_ST59TA -291.416 -3.41e+02 -291.416 -241.7209 83.6 55.4 48.1 0.13324 0.00e+00 4.04e-15 2.31e-05 1.00e-07 0.15
De_M_ST32TA -136.544 -1.75e+02 -136.544 -97.9165 90.8 53.8 50.3 0.09104 2.13e-12 1.74e-05 7.81e-03 7.42e-04 0.10
De_M_ST26TA 173.749 1.22e+02 173.749 225.4056 96.2 53.5 50.3 0.13514 2.16e-11 4.17e-06 1.88e-04 1.15e-04 0.10
Ba_ICV -0.135 -1.79e-01 -0.135 -0.0906 97.5 48.7 46.3 0.11901 1.24e-09 1.98e-07 8.54e-04 1.81e-04 0.30
De_M_ST26CV -43.738 -6.01e+01 -43.738 -27.4099 95.3 52.3 50.3 0.08250 7.59e-08 5.64e-05 1.55e-02 2.44e-03 0.10
De_M_ST24CV -20.033 -2.77e+01 -20.033 -12.3308 92.1 52.2 50.3 0.05548 1.72e-07 5.73e-03 7.57e-02 4.03e-02 0.10
RD_ST32TA 26.312 1.57e+01 26.312 36.9143 87.2 46.6 45.0 0.01494 5.75e-07 4.02e-02 3.37e-01 2.60e-01 1.00
Ba_RD_ST40CV 3.127 1.85e+00 3.127 4.4092 92.6 51.9 50.3 0.08962 8.69e-07 1.26e-03 8.18e-03 3.68e-03 0.10
De_M_ST51TA 1205.483 6.86e+02 1205.483 1724.7535 97.0 46.4 45.0 0.03442 2.68e-06 2.36e-02 1.76e-01 1.07e-01 1.00
De_M_ST31TA -1161.218 -1.70e+03 -1161.218 -626.1671 94.6 46.2 45.1 0.05184 1.05e-05 3.41e-03 8.40e-02 2.93e-02 0.90
De_Ventricles 291.033 1.52e+02 291.033 430.0559 89.0 46.1 45.0 0.05960 2.04e-05 2.78e-03 4.92e-02 1.17e-02 1.00
De_M_ST43TA 119.652 6.25e+01 119.652 176.8476 96.5 45.5 44.4 0.05358 2.06e-05 7.93e-03 8.10e-02 3.96e-02 0.15
RD_ST56TA 41.539 2.13e+01 41.539 61.7382 94.6 46.1 45.0 0.03570 2.78e-05 4.05e-02 1.66e-01 1.31e-01 1.00
De_M_ST31SA -24.610 -3.69e+01 -24.610 -12.3319 92.4 46.6 45.6 0.04315 4.27e-05 7.48e-03 1.28e-01 6.52e-02 0.75
RD_ST31TA 23.748 1.19e+01 23.748 35.6319 90.0 46.1 45.1 0.03035 4.49e-05 6.11e-03 2.09e-01 7.98e-02 0.90
Gender -0.667 -1.00e+00 -0.667 -0.3311 96.6 47.3 46.3 0.07207 5.02e-05 1.90e-04 2.42e-02 5.62e-03 0.30
De_M_ST40TA -70.203 -1.07e+02 -70.203 -33.4820 97.4 45.9 44.9 0.06401 8.95e-05 9.19e-02 3.97e-02 7.65e-02 0.10
RD_ST57TA 27.604 1.32e+01 27.604 42.0533 92.5 46.0 45.1 0.05862 9.04e-05 8.87e-02 5.84e-02 1.13e-01 0.95
De_M_ST55SA -21.673 -3.31e+01 -21.673 -10.2440 94.9 46.0 45.1 0.03917 1.01e-04 3.24e-02 1.34e-01 1.60e-01 0.75
M_ST129TS 503.213 2.32e+02 503.213 774.0919 95.7 46.2 45.3 0.05832 1.36e-04 9.12e-04 6.23e-02 2.03e-02 0.45
De_M_ST38TA 463.619 2.06e+02 463.619 720.8942 97.6 46.0 45.2 0.01394 2.06e-04 9.95e-02 3.85e-01 2.10e-01 0.50
De_RD_ST49CV 4.484 1.97e+00 4.484 6.9948 97.0 44.9 44.1 -0.00569 2.32e-04 1.02e-01 4.99e-01 1.83e-01 0.10
M_ST17SV 25.152 1.10e+01 25.152 39.3426 97.4 45.8 45.0 0.11901 2.56e-04 3.36e-06 8.54e-04 6.03e-04 0.30
De_M_ST49TA 180.140 7.60e+01 180.140 284.3079 95.6 46.2 45.4 0.05334 3.50e-04 1.42e-01 8.23e-02 1.74e-01 0.20
RD_ST26TA 2.842 1.12e+00 2.842 4.5642 90.0 49.0 48.3 0.00711 6.10e-04 9.23e-02 4.84e-01 2.02e-01 0.15
De_M_ST58TA 64.756 2.21e+01 64.756 107.4144 94.6 50.9 50.3 0.00427 1.46e-03 5.74e-02 4.70e-01 2.61e-01 0.10
Ba_M_ST21SV 11.668 3.93e+00 11.668 19.4031 87.7 50.9 50.3 0.03129 1.55e-03 7.63e-02 2.05e-01 1.73e-01 0.10
M_ST43TS 501.764 1.53e+02 501.764 850.9519 97.5 45.5 45.0 0.02347 2.43e-03 4.79e-02 2.54e-01 1.52e-01 0.40
De_RD_ST31CV 7.651 1.57e+00 7.651 13.7292 95.6 45.8 45.4 -0.01328 6.81e-03 8.93e-02 5.86e-01 3.16e-01 0.30
RD_ST24TA 0.611 6.04e-02 0.611 1.1624 88.8 50.6 50.3 0.04125 1.48e-02 4.13e-01 1.42e-01 3.34e-01 0.10
pander::pander(bmlD$univariate[bmlD$selectedfeatures,])
  Name RName ZUni
Ba_Hippocampus Ba_Hippocampus Ba_Hippocampus Inf
De_M_ST24TA De_M_ST24TA De_M_ST24TA 7.52
De_Ventricles De_Ventricles De_Ventricles 8.13
RD_ST32TA RD_ST32TA RD_ST32TA Inf
De_M_ST55SA De_M_ST55SA De_M_ST55SA 4.61
De_RD_ST31CV De_RD_ST31CV De_RD_ST31CV 3.99
De_M_ST51TA De_M_ST51TA De_M_ST51TA 2.38
RD_ST57TA RD_ST57TA RD_ST57TA 6.27
De_M_ST31TA De_M_ST31TA De_M_ST31TA 4.79
RD_ST56TA RD_ST56TA RD_ST56TA 4.85
RD_ST31TA RD_ST31TA RD_ST31TA 7.63
M_ST43TS M_ST43TS M_ST43TS 1.48
De_M_ST31SA De_M_ST31SA De_M_ST31SA 6.30
M_ST129TS M_ST129TS M_ST129TS 3.89
De_M_ST38TA De_M_ST38TA De_M_ST38TA 1.19
De_M_ST23TA De_M_ST23TA De_M_ST23TA 3.80
M_ST60SA M_ST60SA M_ST60SA 2.76
De_RD_ST49CV De_RD_ST49CV De_RD_ST49CV 2.39
M_ST17SV M_ST17SV M_ST17SV 1.76
De_M_ST43TA De_M_ST43TA De_M_ST43TA 2.99
De_M_ST40TA De_M_ST40TA De_M_ST40TA 1.58
De_M_ST32TA De_M_ST32TA De_M_ST32TA 7.19
Ba_M_ST59TA Ba_M_ST59TA Ba_M_ST59TA Inf
Ba_ICV Ba_ICV Ba_ICV 1.53
RD_ST24TA RD_ST24TA RD_ST24TA 8.21
De_M_ST24CV De_M_ST24CV De_M_ST24CV 6.51
RD_ST26TA RD_ST26TA RD_ST26TA 7.62
De_M_ST49TA De_M_ST49TA De_M_ST49TA 3.95
Gender Gender Gender 2.98
Ba_M_ST21SV Ba_M_ST21SV Ba_M_ST21SV Inf
Ba_RD_ST32CV Ba_RD_ST32CV Ba_RD_ST32CV 5.50
De_M_ST40SA De_M_ST40SA De_M_ST40SA 7.46
De_M_ST58TA De_M_ST58TA De_M_ST58TA 4.83
De_M_ST26TA De_M_ST26TA De_M_ST26TA 3.39
Ba_RD_ST40CV Ba_RD_ST40CV Ba_RD_ST40CV 6.17
De_M_ST26CV De_M_ST26CV De_M_ST26CV 4.22
De_M_ST51CV De_M_ST51CV De_M_ST51CV 2.20
Ba_M_ST24SA Ba_M_ST24SA Ba_M_ST24SA 3.75
M_ST47TS M_ST47TS M_ST47TS 1.18
Ba_M_ST35SA Ba_M_ST35SA Ba_M_ST35SA 2.11

prreg <- predictionStats_regression(cbind(TADPOLECrossMRITestD$ADAS13,predict(bmlD,TADPOLECrossMRITestD)),"ADAS13")

ADAS13

pander::pander(prreg)
  • corci:

    cor    
    0.678 0.636 0.716
  • biasci: 0.956, 0.460 and 1.453

  • RMSEci: 6.78, 6.44 and 7.15

  • spearmanci:

    50% 2.5% 97.5%
    0.614 0.561 0.661
  • MAEci:

    50% 2.5% 97.5%
    5.35 5.06 5.67
  • pearson:

    Pearson’s product-moment correlation: predictions[, 1] and predictions[, 2]
    Test statistic df P value Alternative hypothesis cor
    24.4 702 8.7e-96 * * * two.sided 0.678
par(op)

2.2.1 The formula network

cmax <- apply(bmlD$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.250])
cmax <- cmax[cnames]

adma <- bmlD$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=5*E(gr)$weight,
     vertex.size=20*cmax,
     vertex.label.cex=0.5,
     vertex.label.dist=0,
     main="ADAS13 Feature Association")

par(op)

2.2.2 Decorrelated ADAS13 table


clusterFeatures <- fc$names
sm$coefficients$Rx2 <- (sm$coefficients$r.MSE-sm$coefficients$model.MSE)/sm$coefficients$r.MSE

tableADAS13D <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "mean",
                                     "upper",
                                     "model.MSE",
                                     "Rx2",
                                     "F.pvalue",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableADAS13D$Cluster <- nugget[rownames(tableADAS13D)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
rnames <- str_replace_all(rnames,"Ba_","")
rnames <- str_replace_all(rnames,"De_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableADAS13D$Description <- description[rownames(tableADAS13D)]

## Getting the decorrelation formula
dc <- getDerivedCoefficients(TADPOLECrossMRITrainD)
decornames <- rownames(sm$coefficients)

deNames_in_dc <- decornames[decornames %in% names(dc)]
theDeFormulas <- dc[deNames_in_dc]
deFromula <- character(length(theDeFormulas))
names(deFromula) <- names(theDeFormulas)
for (dx in names(deFromula))
{
  coef <- theDeFormulas[[dx]]
  cname <- names(theDeFormulas[[dx]])
  names(cname) <- cname
  for (cf in names(coef))
  {
    if (cf != dx)
    {
      if (coef[cf]>0)
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("+ %5.3f*%s",coef[cf],cname[cf]))
      }
      else
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("%5.3f*%s",coef[cf],cname[cf]))
      }
    }
  }
}

tableADAS13D$DecorFormula <- deFromula[rownames(tableADAS13D)]


pander::pander(tableADAS13D)
  Estimate lower mean upper model.MSE Rx2 F.pvalue Frequency Cluster Description DecorFormula
Ba_Hippocampus -415.962 -474.664 -415.962 -357.2610 45.0 0.26090 0.00e+00 1.00 1 NA NA
De_M_ST24TA -699.354 -803.816 -699.354 -594.8917 45.0 0.09919 0.00e+00 1.00 1 Cortical Thickness Average of LeftEntorhinal -0.306Hippocampus + 1.000M_ST24TA
De_Ventricles 291.033 152.010 291.033 430.0559 45.0 0.02374 2.04e-05 1.00 1 NA + 1.000Ventricles -1.284M_ST37SV
RD_ST32TA 26.312 15.709 26.312 36.9143 45.0 0.03317 5.75e-07 1.00 1 Cortical Thickness Average of LeftInferiorTemporal NA
De_M_ST55SA -21.673 -33.102 -21.673 -10.2440 45.1 0.01958 1.01e-04 0.75 1 Surface Area of LeftRostralMiddleFrontal NA
De_RD_ST31CV 7.651 1.573 7.651 13.7292 45.4 0.00866 6.81e-03 0.30 2 Volume (Cortical Parcellation) of LeftInferiorParietal -0.644RD_ST31SA + 1.000RD_ST31CV
De_M_ST51TA 1205.483 686.212 1205.483 1724.7535 45.0 0.02911 2.68e-06 1.00 1 Cortical Thickness Average of LeftPrecentral -0.676M_ST43TA + 1.000M_ST51TA -0.427*M_ST59TA
RD_ST57TA 27.604 13.155 27.604 42.0533 45.1 0.01977 9.04e-05 0.95 1 Cortical Thickness Average of LeftSuperiorParietal NA
De_M_ST31TA -1161.218 -1696.268 -1161.218 -626.1671 45.1 0.02542 1.05e-05 0.90 1 Cortical Thickness Average of LeftInferiorParietal + 1.000M_ST31TA -0.918M_ST59TA
RD_ST56TA 41.539 21.340 41.539 61.7382 45.0 0.02286 2.78e-05 1.00 1 Cortical Thickness Average of LeftSuperiorFrontal NA
RD_ST31TA 23.748 11.864 23.748 35.6319 45.1 0.02163 4.49e-05 0.90 1 Cortical Thickness Average of LeftInferiorParietal NA
M_ST43TS 501.764 152.575 501.764 850.9519 45.0 0.01126 2.43e-03 0.40 2 Cortical Thickness Standard Deviation of LeftParacentral NA
De_M_ST31SA -24.610 -36.887 -24.610 -12.3319 45.6 0.02211 4.27e-05 0.75 2 Surface Area of LeftInferiorParietal NA
M_ST129TS 503.213 232.334 503.213 774.0919 45.3 0.01872 1.36e-04 0.45 1 Cortical Thickness Standard Deviation of LeftInsula NA
De_M_ST38TA 463.619 206.344 463.619 720.8942 45.2 0.01762 2.06e-04 0.50 1 Cortical Thickness Average of LeftLingual + 1.000M_ST38TA -0.576M_ST59TA
M_ST17SV 25.152 10.961 25.152 39.3426 45.0 0.01704 2.56e-04 0.30 1 Volume (WM Parcellation) of LeftCerebellumCortex NA
Ba_ICV -0.135 -0.179 -0.135 -0.0906 46.3 0.04999 1.24e-09 0.30 2 NA NA
Gender -0.667 -1.004 -0.667 -0.3311 46.3 0.02132 5.02e-05 0.30 2 NA NA

3 Diagnosis MCI vs AD

3.0.1 the set

TrainFraction <- 0.60;

TADPOLECrossMRI <- subset(validBaselineTadpole,DX == "Dementia" | DX == "MCI")
table(TADPOLECrossMRI$DX)

Dementia MCI NL 244 711 0


TADPOLECrossMRI$DX <- 1*(as.character(TADPOLECrossMRI$DX) == "Dementia")
table(TADPOLECrossMRI$DX)

0 1 711 244

TADPOLECrossMRI$ADAS13 <- NULL
TADPOLECrossMRI$ADAS11 <- NULL
TADPOLECrossMRI$MMSE <- NULL
TADPOLECrossMRI$RAVLT_immediate <- NULL
TADPOLECrossMRI$RAVLT_learning <- NULL
TADPOLECrossMRI$RAVLT_perc_forgetting <- NULL
TADPOLECrossMRI$RAVLT_forgetting <- NULL
TADPOLECrossMRI$FAQ <- NULL

TADPOLE_Cases <- subset(TADPOLECrossMRI,DX==1)
TADPOLE_Controls <- subset(TADPOLECrossMRI,DX==0)
trainCasesSet <- sample(nrow(TADPOLE_Cases),nrow(TADPOLE_Cases)*TrainFraction)
trainControlSet <- sample(nrow(TADPOLE_Controls),nrow(TADPOLE_Controls)*TrainFraction)

TADPOLE_DX_TRAIN <- rbind(TADPOLE_Cases[trainCasesSet,],TADPOLE_Controls[trainControlSet,])
TADPOLE_DX_TEST <- TADPOLECrossMRI[!(rownames(TADPOLECrossMRI) %in% rownames(TADPOLE_DX_TRAIN)),]
table(TADPOLE_DX_TEST$DX)

0 1 285 98


par(op)

3.0.2 Learning

bDXml <- BSWiMS.model(DX~.,TADPOLE_DX_TRAIN,NumberofRepeats = 20)

[+++-++++++—+++++-+++-+++-++-+++–+-++++-++++-+-++++–+++-++++-+–+++++–+++–+++-++++-++++-++++-+++++–+++-+++–]……..

pander::pander(bDXml$bagging$Jaccard.SM)

0.123


fs <- bDXml$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bDXml)
pander::pander(sm$coefficients)
  Estimate lower OR upper u.Accuracy r.Accuracy full.Accuracy u.AUC r.AUC full.AUC IDI NRI z.IDI z.NRI Frequency
M_ST24TA -72.1718 1.71e-36 4.53e-32 1.20e-27 0.721 0.663 0.744 0.722 0.652 0.749 0.1677 0.828 13.34 13.36 1.00
M_ST40TA -55.4204 1.29e-28 8.54e-25 5.64e-21 0.678 0.666 0.723 0.671 0.663 0.719 0.0922 0.588 9.38 9.04 0.45
M_ST24CV -27.2158 1.77e-14 1.51e-12 1.30e-10 0.714 0.699 0.745 0.707 0.692 0.745 0.0899 0.635 9.14 9.91 1.00
M_ST31TA -28.9532 9.54e-16 2.67e-13 7.44e-11 0.655 0.736 0.742 0.645 0.727 0.746 0.0711 0.499 8.07 7.59 0.20
M_ST12SV -25.8479 4.60e-14 5.95e-12 7.70e-10 0.692 0.701 0.736 0.701 0.696 0.739 0.0672 0.555 7.86 8.49 1.00
M_ST31CV -20.2570 2.30e-11 1.59e-09 1.11e-07 0.662 0.724 0.742 0.654 0.718 0.747 0.0606 0.448 7.54 6.75 0.95
Hippocampus -9.9733 5.00e-06 4.66e-05 4.35e-04 0.675 0.699 0.716 0.677 0.696 0.721 0.0606 0.535 7.32 8.14 0.65
M_ST52CV -5.5476 1.14e-03 3.90e-03 1.33e-02 0.638 0.699 0.725 0.631 0.698 0.731 0.0589 0.421 7.12 6.35 0.20
M_ST32TA -48.6612 7.79e-27 7.36e-22 6.95e-17 0.672 0.700 0.729 0.671 0.698 0.730 0.0578 0.468 6.97 7.09 0.70
M_ST30SV 2.1112 4.98e+00 8.26e+00 1.37e+01 0.648 0.689 0.712 0.645 0.682 0.713 0.0505 0.444 6.62 6.68 0.25
M_ST32CV -13.7800 2.15e-08 1.04e-06 4.99e-05 0.678 0.712 0.737 0.677 0.713 0.738 0.0500 0.429 6.44 6.44 0.95
M_ST40CV -7.7090 5.05e-05 4.49e-04 3.99e-03 0.696 0.714 0.728 0.703 0.717 0.733 0.0465 0.454 6.27 6.84 0.50
M_ST26CV -1.6643 1.26e-01 1.89e-01 2.85e-01 0.664 0.696 0.715 0.656 0.698 0.718 0.0452 0.421 5.97 6.35 0.10
ICV -0.0337 9.56e-01 9.67e-01 9.78e-01 0.514 0.720 0.739 0.526 0.728 0.743 0.0356 0.343 5.78 5.11 1.00
M_ST32SA -1.0856 2.38e-01 3.38e-01 4.78e-01 0.604 0.691 0.720 0.595 0.688 0.712 0.0361 0.345 5.65 5.13 0.25
M_ST36TA 7.3869 1.20e+02 1.61e+03 2.17e+04 0.585 0.694 0.712 0.593 0.697 0.716 0.0362 0.400 5.51 5.98 0.10
M_ST39CV 14.8041 1.23e+04 2.69e+06 5.86e+08 0.589 0.715 0.736 0.588 0.722 0.740 0.0282 0.262 5.12 3.89 0.95
RD_ST52TA 1.5455 2.62e+00 4.69e+00 8.40e+00 0.608 0.727 0.743 0.559 0.729 0.742 0.0315 0.267 5.10 4.03 0.45
M_ST45TA 22.3568 7.28e+05 5.12e+09 3.60e+13 0.592 0.699 0.723 0.575 0.691 0.716 0.0267 0.349 4.87 5.19 0.25
M_ST25TA 7.0126 6.69e+01 1.11e+03 1.84e+04 0.533 0.711 0.717 0.522 0.707 0.719 0.0242 0.333 4.82 4.94 0.15
M_ST43TS 22.2526 5.20e+05 4.62e+09 4.10e+13 0.532 0.730 0.747 0.516 0.729 0.749 0.0261 0.191 4.72 2.82 0.10
M_ST46TS 116.2719 7.02e+29 3.14e+50 1.40e+71 0.562 0.725 0.740 0.546 0.725 0.741 0.0241 0.306 4.69 4.55 1.00
RD_ST32TA 0.4213 1.28e+00 1.52e+00 1.81e+00 0.642 0.705 0.727 0.607 0.711 0.731 0.0238 0.329 4.69 4.95 0.30
M_ST24SA 2.2443 3.49e+00 9.43e+00 2.55e+01 0.538 0.728 0.743 0.554 0.729 0.742 0.0200 0.222 4.34 3.26 0.25
M_ST39SA 3.0038 5.29e+00 2.02e+01 7.69e+01 0.536 0.724 0.742 0.537 0.728 0.744 0.0186 0.210 4.30 3.09 0.70
Ventricles -0.1639 7.83e-01 8.49e-01 9.20e-01 0.600 0.693 0.706 0.605 0.699 0.712 0.0173 0.252 3.93 3.72 0.10
M_ST60SA 1.0763 1.73e+00 2.93e+00 4.97e+00 0.540 0.715 0.730 0.539 0.715 0.730 0.0158 0.200 3.89 2.95 0.20
pander::pander(bDXml$univariate[bDXml$selectedfeatures,])
  Name RName ZUni
M_ST24TA M_ST24TA M_ST24TA 10.41
M_ST31CV M_ST31CV M_ST31CV 7.60
M_ST24CV M_ST24CV M_ST24CV 9.39
RD_ST52TA RD_ST52TA RD_ST52TA 3.90
M_ST31TA M_ST31TA M_ST31TA 7.28
ICV ICV ICV 1.14
M_ST24SA M_ST24SA M_ST24SA 1.88
M_ST43TS M_ST43TS M_ST43TS 2.26
M_ST12SV M_ST12SV M_ST12SV 9.19
M_ST39CV M_ST39CV M_ST39CV 3.00
M_ST32CV M_ST32CV M_ST32CV 8.51
M_ST46TS M_ST46TS M_ST46TS 2.05
M_ST40CV M_ST40CV M_ST40CV 8.30
M_ST60SA M_ST60SA M_ST60SA 1.64
M_ST39SA M_ST39SA M_ST39SA 1.46
M_ST32TA M_ST32TA M_ST32TA 8.31
RD_ST32TA RD_ST32TA RD_ST32TA 4.19
Hippocampus Hippocampus Hippocampus 8.55
M_ST52CV M_ST52CV M_ST52CV 7.26
M_ST40TS M_ST40TS M_ST40TS 1.61
M_ST36TA M_ST36TA M_ST36TA 3.47
M_ST26CV M_ST26CV M_ST26CV 7.77
M_ST40TA M_ST40TA M_ST40TA 7.71
M_ST30SV M_ST30SV M_ST30SV 7.61
M_ST32SA M_ST32SA M_ST32SA 5.06
M_ST25TA M_ST25TA M_ST25TA 1.24
M_ST45TA M_ST45TA M_ST45TA 4.02
Ventricles Ventricles Ventricles 4.29

prBin <- predictionStats_binary(cbind(TADPOLE_DX_TEST$DX,predict(bDXml,TADPOLE_DX_TEST)),"MCI vs Dementia")

MCI vs Dementia

pander::pander(prBin$aucs)
est lower upper
0.816 0.77 0.862
pander::pander(prBin$accc)
est lower upper
0.749 0.703 0.792
pander::pander(prBin$berror)
50% 2.5% 97.5%
0.238 0.194 0.288
pander::pander(prBin$sensitivity)
est lower upper
0.786 0.691 0.862
par(op)

3.0.3 The formula network

cmax <- apply(bDXml$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.25])
cmax <- cmax[cnames]

adma <- bDXml$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=10*E(gr)$weight,
     vertex.size=10*cmax,
     vertex.label.cex=0.75,
     vertex.label.dist=0,
     main="MCI vs Dementia Diagnosis")

par(op)

3.0.4 MCI vs AD table


clusterFeatures <- fc$names
sm$coefficients$DeltaAUC <- (sm$coefficients$full.AUC-sm$coefficients$r.AUC)

tableMCI_De <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "OR",
                                     "upper",
                                     "full.AUC",
                                     "DeltaAUC",
                                     "z.IDI",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableMCI_De$Cluster <- nugget[rownames(tableMCI_De)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableMCI_De$Description <- description[rownames(tableMCI_De)]
pander::pander(tableMCI_De)
  Estimate lower OR upper full.AUC DeltaAUC z.IDI Frequency Cluster Description
M_ST24TA -72.1718 1.71e-36 4.53e-32 1.20e-27 0.749 0.0970 13.34 1.00 1 Cortical Thickness Average of LeftEntorhinal
M_ST31CV -20.2570 2.30e-11 1.59e-09 1.11e-07 0.747 0.0298 7.54 0.95 1 Volume (Cortical Parcellation) of LeftInferiorParietal
M_ST24CV -27.2158 1.77e-14 1.51e-12 1.30e-10 0.745 0.0526 9.14 1.00 2 Volume (Cortical Parcellation) of LeftEntorhinal
RD_ST52TA 1.5455 2.62e+00 4.69e+00 8.40e+00 0.742 0.0130 5.10 0.45 1 Cortical Thickness Average of LeftPrecuneus
ICV -0.0337 9.56e-01 9.67e-01 9.78e-01 0.743 0.0144 5.78 1.00 1 NA
M_ST24SA 2.2443 3.49e+00 9.43e+00 2.55e+01 0.742 0.0135 4.34 0.25 2 Surface Area of LeftEntorhinal
M_ST12SV -25.8479 4.60e-14 5.95e-12 7.70e-10 0.739 0.0425 7.86 1.00 2 Volume (WM Parcellation) of LeftAmygdala
M_ST39CV 14.8041 1.23e+04 2.69e+06 5.86e+08 0.740 0.0188 5.12 0.95 3 Volume (Cortical Parcellation) of LeftMedialOrbitofrontal
M_ST32CV -13.7800 2.15e-08 1.04e-06 4.99e-05 0.738 0.0244 6.44 0.95 2 Volume (Cortical Parcellation) of LeftInferiorTemporal
M_ST46TS 116.2719 7.02e+29 3.14e+50 1.40e+71 0.741 0.0165 4.69 1.00 2 Cortical Thickness Standard Deviation of LeftParsOrbitalis
M_ST40CV -7.7090 5.05e-05 4.49e-04 3.99e-03 0.733 0.0167 6.27 0.50 3 Volume (Cortical Parcellation) of LeftMiddleTemporal
M_ST39SA 3.0038 5.29e+00 2.02e+01 7.69e+01 0.744 0.0167 4.30 0.70 2 Surface Area of LeftMedialOrbitofrontal
M_ST32TA -48.6612 7.79e-27 7.36e-22 6.95e-17 0.730 0.0323 6.97 0.70 2 Cortical Thickness Average of LeftInferiorTemporal
RD_ST32TA 0.4213 1.28e+00 1.52e+00 1.81e+00 0.731 0.0198 4.69 0.30 3 Cortical Thickness Average of LeftInferiorTemporal
Hippocampus -9.9733 5.00e-06 4.66e-05 4.35e-04 0.721 0.0244 7.32 0.65 3 NA
M_ST40TA -55.4204 1.29e-28 8.54e-25 5.64e-21 0.719 0.0564 9.38 0.45 4 Cortical Thickness Average of LeftMiddleTemporal
M_ST30SV 2.1112 4.98e+00 8.26e+00 1.37e+01 0.713 0.0314 6.62 0.25 4 Volume (WM Parcellation) of LeftInferiorLateralVentricle
M_ST32SA -1.0856 2.38e-01 3.38e-01 4.78e-01 0.712 0.0243 5.65 0.25 4 Surface Area of LeftInferiorTemporal
M_ST45TA 22.3568 7.28e+05 5.12e+09 3.60e+13 0.716 0.0251 4.87 0.25 4 Cortical Thickness Average of LeftParsOpercularis

3.1 Decorrelating the sets


TADPOLE_DX_TRAIND <- GDSTMDecorrelation(TADPOLE_DX_TRAIN,Outcome="DX",
                                        thr=0.6,
                                        type="RLM",
                                        method="spearman",
                                        verbose = TRUE)
#> 
#>  Included: 197 , Uni p: 0.01215481 To Outcome: 99 , Base: 5 , In Included: 5 , Base Cor: 16 
#> 1 , Top: 37 < 0.6 >( 2 )[ 1 : 0 : 0.594 ]( 36 , 80 , 0 ),<>Tot Used: 116 , Added: 80 , Zero Std: 0 , Max Cor: 0.9913617 
#> 2 , Top: 22 < 0.6 >[ FALSE ]( 1 )[ 1 : 0 : 0.594 ]( 19 , 38 , 36 ),<>Tot Used: 143 , Added: 38 , Zero Std: 0 , Max Cor: 0.9278401 
#> 3 , Top: 19 < 0.6 >( 1 )[ 1 : 0 : 0.594 ]( 18 , 19 , 53 ),<>Tot Used: 152 , Added: 19 , Zero Std: 0 , Max Cor: 0.9040669 
#> 4 , Top: 9 < 0.6 >[ TRUE ]( 2 )[ 1 : 0 : 0 ]( 9 , 11 , 68 ),<>Tot Used: 155 , Added: 11 , Zero Std: 0 , Max Cor: 0.8911764 
#> 5 , Top: 6 < 0.6 >[ TRUE ]( 1 )[ 1 : 0 : 0 ]( 6 , 6 , 71 ),<>Tot Used: 155 , Added: 6 , Zero Std: 0 , Max Cor: 0.6234069 
#> 6 , Top: 3 < 0.6 >[ FALSE ]( 1 )[ 1 : 0 : 0 ]( 3 , 3 , 77 ),<>Tot Used: 158 , Added: 3 , Zero Std: 0 , Max Cor: 0.878083 
#> 7 , Top: 1 < 0.6 >[ FALSE ]( 1 )[ 1 : 0 : 0.6 ]( 1 , 1 , 80 ),<>Tot Used: 159 , Added: 1 , Zero Std: 0 , Max Cor: 0.5995342 
#> [ 8 ], 0.5995342 . Cor to Base: 88 , ABase: 69
TADPOLE_DX_TESTD <-  predictDecorrelate(TADPOLE_DX_TRAIND,TADPOLE_DX_TEST)

3.1.1 Decorrelated ML

bDXmlD <- BSWiMS.model(DX~.,TADPOLE_DX_TRAIND,NumberofRepeats = 20)

[++-++—++-+++-++-+–++-++-++—+++-++–+++-++-+++-+++-++-++-++-++-++-]….

pander::pander(bDXmlD$bagging$Jaccard.SM)

0.288


fs <- bDXmlD$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bDXmlD)
pander::pander(sm$coefficients)
  Estimate lower OR upper u.Accuracy r.Accuracy full.Accuracy u.AUC r.AUC full.AUC IDI NRI z.IDI z.NRI Frequency
Ba_M_ST24TA -102.962 9.41e-52 1.92e-45 3.93e-39 0.722 0.635 0.755 0.723 0.638 0.760 0.1898 0.854 14.42 13.82 1.00
Ba_M_ST31TA -200.910 1.04e-100 5.57e-88 2.97e-75 0.654 0.688 0.727 0.645 0.684 0.728 0.0979 0.551 9.75 8.41 0.95
De_M_ST26CV -13.321 1.23e-07 1.64e-06 2.18e-05 0.635 0.694 0.734 0.634 0.697 0.739 0.0647 0.473 7.56 7.16 0.30
De_M_ST60CV -80.738 1.67e-43 8.63e-36 4.47e-28 0.638 0.691 0.727 0.638 0.688 0.727 0.0581 0.515 7.48 7.81 0.90
De_M_ST48TA 291.460 1.56e+90 3.80e+126 9.23e+162 0.626 0.734 0.751 0.627 0.734 0.756 0.0428 0.478 6.39 7.21 1.00
De_M_ST44TA -16.752 9.55e-10 5.31e-08 2.95e-06 0.625 0.700 0.724 0.626 0.699 0.727 0.0451 0.340 6.13 5.06 0.25
De_M_ST30SV 17.547 9.58e+04 4.18e+07 1.82e+10 0.637 0.719 0.727 0.628 0.721 0.728 0.0329 0.348 5.56 5.18 0.95
Ba_M_ST32SA -1.318 1.65e-01 2.68e-01 4.33e-01 0.607 0.718 0.731 0.596 0.713 0.737 0.0328 0.389 5.30 5.80 0.20
De_M_ST31SA -2.203 4.89e-02 1.10e-01 2.50e-01 0.548 0.713 0.722 0.556 0.712 0.724 0.0292 0.237 5.20 3.49 0.30
De_M_ST11SV -42.720 1.82e-26 2.80e-19 4.29e-12 0.616 0.707 0.730 0.609 0.711 0.733 0.0268 0.308 5.01 4.56 0.20
M_ST129TS 117.340 2.46e+30 9.13e+50 3.39e+71 0.587 0.712 0.731 0.568 0.709 0.732 0.0265 0.323 4.76 4.80 0.45
De_M_ST43TA 13.297 2.50e+03 5.96e+05 1.42e+08 0.566 0.744 0.753 0.559 0.745 0.757 0.0256 0.305 4.69 4.52 0.10
RD_ST52TA 1.423 2.30e+00 4.15e+00 7.49e+00 0.609 0.738 0.749 0.558 0.745 0.752 0.0271 0.232 4.59 3.50 0.25
De_M_ST49CV -27.259 1.23e-17 1.45e-12 1.70e-07 0.574 0.737 0.753 0.565 0.747 0.757 0.0236 0.150 4.50 2.20 0.95
M_ST43TS 146.322 2.09e+33 3.52e+63 5.94e+93 0.529 0.737 0.745 0.514 0.741 0.749 0.0198 0.201 4.00 2.96 0.50
Ba_M_ST13SA -0.955 2.40e-01 3.85e-01 6.17e-01 0.581 0.713 0.723 0.595 0.710 0.715 0.0170 0.340 3.88 5.07 0.10
pander::pander(bDXmlD$univariate[bDXmlD$selectedfeatures,])
  Name RName ZUni
Ba_M_ST24TA Ba_M_ST24TA Ba_M_ST24TA 10.41
De_M_ST43TA De_M_ST43TA De_M_ST43TA 3.51
De_M_ST48TA De_M_ST48TA De_M_ST48TA 5.36
De_M_ST49CV De_M_ST49CV De_M_ST49CV 4.90
RD_ST52TA RD_ST52TA RD_ST52TA 3.90
Ba_M_ST31TA Ba_M_ST31TA Ba_M_ST31TA 7.28
De_M_ST60CV De_M_ST60CV De_M_ST60CV 5.86
De_M_ST30SV De_M_ST30SV De_M_ST30SV 7.03
M_ST43TS M_ST43TS M_ST43TS 2.26
M_ST129TS M_ST129TS M_ST129TS 3.24
De_M_ST26CV De_M_ST26CV De_M_ST26CV 6.34
De_M_ST31SA De_M_ST31SA De_M_ST31SA 4.01
Ba_M_ST13SA Ba_M_ST13SA Ba_M_ST13SA 3.62
De_M_ST62TA De_M_ST62TA De_M_ST62TA 2.71
De_M_ST44TA De_M_ST44TA De_M_ST44TA 6.73
Ba_M_ST32SA Ba_M_ST32SA Ba_M_ST32SA 5.06
De_M_ST11SV De_M_ST11SV De_M_ST11SV 5.54
De_M_ST32TA De_M_ST32TA De_M_ST32TA 4.08

prBin <- predictionStats_binary(cbind(TADPOLE_DX_TESTD$DX,predict(bDXmlD,TADPOLE_DX_TESTD)),"NL vs Dementia")

NL vs Dementia

pander::pander(prBin$aucs)
est lower upper
0.777 0.727 0.827
pander::pander(prBin$accc)
est lower upper
0.702 0.654 0.748
pander::pander(prBin$berror)
50% 2.5% 97.5%
0.322 0.272 0.378
pander::pander(prBin$sensitivity)
est lower upper
0.622 0.519 0.718
par(op)

3.1.2 The formula network

cmax <- apply(bDXmlD$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.25])
cmax <- cmax[cnames]

adma <- bDXmlD$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=10*E(gr)$weight,
     vertex.size=10*cmax,
     vertex.label.cex=0.75,
     vertex.label.dist=0,
     main="NL vs Dementia Diagnosis")

par(op)

3.1.3 Decorrelated MCI vs AD table


clusterFeatures <- fc$names
sm$coefficients$DeltaAUC <- (sm$coefficients$full.AUC-sm$coefficients$r.AUC)

tableMCI_DeD <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "OR",
                                     "upper",
                                     "full.AUC",
                                     "DeltaAUC",
                                     "z.IDI",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableMCI_DeD$Cluster <- nugget[rownames(tableMCI_DeD)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
rnames <- str_replace_all(rnames,"Ba_","")
rnames <- str_replace_all(rnames,"De_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableMCI_DeD$Description <- description[rownames(tableMCI_DeD)]



## Getting the decorrelation formula
dc <- getDerivedCoefficients(TADPOLE_DX_TRAIND)
decornames <- rownames(sm$coefficients)

deNames_in_dc <- decornames[decornames %in% names(dc)]
theDeFormulas <- dc[deNames_in_dc]
deFromula <- character(length(theDeFormulas))
names(deFromula) <- names(theDeFormulas)
for (dx in names(deFromula))
{
  coef <- theDeFormulas[[dx]]
  cname <- names(theDeFormulas[[dx]])
  names(cname) <- cname
  for (cf in names(coef))
  {
    if (cf != dx)
    {
      if (coef[cf]>0)
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("+ %5.3f*%s",coef[cf],cname[cf]))
      }
      else
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("%5.3f*%s",coef[cf],cname[cf]))
      }
    }
  }
}

tableMCI_DeD$DecorFormula <- deFromula[rownames(tableMCI_DeD)]



pander::pander(tableMCI_DeD)
  Estimate lower OR upper full.AUC DeltaAUC z.IDI Frequency Cluster Description DecorFormula
Ba_M_ST24TA -102.96 9.41e-52 1.92e-45 3.93e-39 0.760 0.12195 14.42 1.00 1 Cortical Thickness Average of LeftEntorhinal NA
De_M_ST48TA 291.46 1.56e+90 3.80e+126 9.23e+162 0.756 0.02211 6.39 1.00 1 Cortical Thickness Average of LeftPericalcarine -0.425M_ST31TA + 1.000M_ST48TA -1.029*M_ST48TS
De_M_ST49CV -27.26 1.23e-17 1.45e-12 1.70e-07 0.757 0.01015 4.50 0.95 1 Volume (Cortical Parcellation) of LeftPostcentral -0.587M_ST39CV + 1.000M_ST49CV
RD_ST52TA 1.42 2.30e+00 4.15e+00 7.49e+00 0.752 0.00673 4.59 0.25 1 Cortical Thickness Average of LeftPrecuneus NA
Ba_M_ST31TA -200.91 1.04e-100 5.57e-88 2.97e-75 0.728 0.04417 9.75 0.95 2 Cortical Thickness Average of LeftInferiorParietal NA
De_M_ST60CV -80.74 1.67e-43 8.63e-36 4.47e-28 0.727 0.03921 7.48 0.90 2 Volume (Cortical Parcellation) of LeftTemporalPole + 0.758M_ST24TA -1.322M_ST60TA + 0.113M_ST39SA -0.335M_ST60SA -0.563M_ST39CV + 1.000M_ST60CV
De_M_ST30SV 17.55 9.58e+04 4.18e+07 1.82e+10 0.728 0.00745 5.56 0.95 2 Volume (WM Parcellation) of LeftInferiorLateralVentricle -0.335Ventricles + 1.000M_ST30SV
M_ST43TS 146.32 2.09e+33 3.52e+63 5.94e+93 0.749 0.00819 4.00 0.50 1 Cortical Thickness Standard Deviation of LeftParacentral NA
M_ST129TS 117.34 2.46e+30 9.13e+50 3.39e+71 0.732 0.02250 4.76 0.45 2 Cortical Thickness Standard Deviation of LeftInsula NA
De_M_ST26CV -13.32 1.23e-07 1.64e-06 2.18e-05 0.739 0.04238 7.56 0.30 1 Volume (Cortical Parcellation) of LeftFusiform -0.219M_ST26SA + 1.000M_ST26CV -0.667*M_ST39CV
De_M_ST31SA -2.20 4.89e-02 1.10e-01 2.50e-01 0.724 0.01241 5.20 0.30 2 Surface Area of LeftInferiorParietal NA
De_M_ST44TA -16.75 9.55e-10 5.31e-08 2.95e-06 0.727 0.02849 6.13 0.25 1 Cortical Thickness Average of LeftParahippocampal NA

4 Diagnosis NL vs AD

4.0.1 the set

TrainFraction <- 0.60;

table(validBaselineTadpole$DX)

Dementia MCI NL 244 711 452


TADPOLECrossMRI <- subset(validBaselineTadpole,DX == "Dementia" | DX == "NL")
table(TADPOLECrossMRI$DX)

Dementia MCI NL 244 0 452


TADPOLECrossMRI$DX <- 1*(as.character(TADPOLECrossMRI$DX) == "Dementia")
table(TADPOLECrossMRI$DX)

0 1 452 244

TADPOLECrossMRI$ADAS13 <- NULL
TADPOLECrossMRI$ADAS11 <- NULL
TADPOLECrossMRI$MMSE <- NULL
TADPOLECrossMRI$RAVLT_immediate <- NULL
TADPOLECrossMRI$RAVLT_learning <- NULL
TADPOLECrossMRI$RAVLT_perc_forgetting <- NULL
TADPOLECrossMRI$RAVLT_forgetting <- NULL
TADPOLECrossMRI$FAQ <- NULL

TADPOLE_Cases <- subset(TADPOLECrossMRI,DX==1)
TADPOLE_Controls <- subset(TADPOLECrossMRI,DX==0)
trainCasesSet <- sample(nrow(TADPOLE_Cases),nrow(TADPOLE_Cases)*TrainFraction)
trainControlSet <- sample(nrow(TADPOLE_Controls),nrow(TADPOLE_Controls)*TrainFraction)

TADPOLE_DX_NLDE_TRAIN <- rbind(TADPOLE_Cases[trainCasesSet,],TADPOLE_Controls[trainControlSet,])
TADPOLE_DX_NLDE_TEST <- TADPOLECrossMRI[!(rownames(TADPOLECrossMRI) %in% rownames(TADPOLE_DX_NLDE_TRAIN)),]


pander::pander(table(TADPOLE_DX_NLDE_TRAIN$DX))
0 1
271 146
pander::pander(table(TADPOLE_DX_NLDE_TEST$DX))
0 1
181 98


par(op)

4.0.2 Learning

bDXmlNLDE <- BSWiMS.model(DX~.,TADPOLE_DX_NLDE_TRAIN,NumberofRepeats = 20)

[++–+—+-+-+++-+++-+++-+++-+++-++–+–+—+++-++-++–+—++-++–+–+++-+–]….

pander::pander(bDXmlNLDE$bagging$Jaccard.SM)

0.273


fs <- bDXmlNLDE$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bDXmlNLDE)
pander::pander(sm$coefficients)
  Estimate lower OR upper u.Accuracy r.Accuracy full.Accuracy u.AUC r.AUC full.AUC IDI NRI z.IDI z.NRI Frequency
M_ST30SV 21.54 1.69e+07 2.26e+09 3.01e+11 0.759 0.841 0.871 0.757 0.836 0.868 0.0782 0.760 7.11 9.76 0.40
Hippocampus -81.07 8.64e-45 6.17e-36 4.40e-27 0.821 0.871 0.900 0.816 0.868 0.899 0.0750 0.791 6.83 10.23 1.00
RD_ST32TA 13.02 1.27e+04 4.49e+05 1.59e+07 0.684 0.867 0.900 0.666 0.863 0.899 0.0745 0.766 6.82 9.85 1.00
M_ST24TA -159.96 2.93e-90 3.39e-70 3.92e-50 0.826 0.873 0.899 0.818 0.872 0.899 0.0663 0.700 6.41 8.86 1.00
M_ST44CV -52.54 7.80e-31 1.53e-23 3.00e-16 0.759 0.842 0.871 0.749 0.838 0.868 0.0619 0.776 6.04 9.98 0.40
M_ST12SV -46.93 8.03e-27 4.17e-21 2.17e-15 0.826 0.865 0.889 0.823 0.860 0.886 0.0479 0.568 5.92 7.03 0.65
M_ST24CV -38.45 5.48e-23 2.00e-17 7.31e-12 0.820 0.865 0.890 0.814 0.866 0.887 0.0549 0.560 5.82 6.97 0.65
M_ST51CV 13.08 4.76e+03 4.78e+05 4.80e+07 0.579 0.867 0.901 0.579 0.867 0.898 0.0448 0.509 5.49 6.23 0.30
M_ST40TA -66.33 9.70e-40 1.57e-29 2.53e-19 0.762 0.849 0.870 0.754 0.847 0.867 0.0503 0.562 5.42 6.92 0.20
M_ST32CV -19.49 2.61e-12 3.43e-09 4.50e-06 0.759 0.850 0.870 0.753 0.846 0.868 0.0468 0.684 5.24 8.58 0.30
M_ST13TA -44.02 4.07e-27 7.66e-20 1.44e-12 0.722 0.864 0.876 0.715 0.862 0.873 0.0465 0.509 5.00 6.23 0.10
M_ST11SV 140.83 4.57e+36 1.45e+61 4.61e+85 0.582 0.854 0.872 0.582 0.853 0.870 0.0354 0.539 4.72 6.62 0.25
Ventricles -2.67 2.32e-02 6.91e-02 2.06e-01 0.670 0.849 0.868 0.671 0.844 0.865 0.0348 0.651 4.68 8.23 0.15
M_ST31TA -112.71 1.85e-70 1.13e-49 6.85e-29 0.705 0.878 0.893 0.699 0.874 0.890 0.0346 0.457 4.48 5.62 0.40
M_ST62TA 79.35 5.72e+19 2.88e+34 1.45e+49 0.594 0.859 0.871 0.588 0.855 0.869 0.0366 0.588 4.43 7.29 0.30
M_ST40CV -29.80 2.58e-19 1.15e-13 5.12e-08 0.741 0.873 0.891 0.742 0.869 0.889 0.0353 0.536 4.37 6.54 0.60
RD_ST40TA 3.18 5.94e+00 2.40e+01 9.72e+01 0.632 0.854 0.873 0.608 0.851 0.869 0.0345 0.411 4.27 4.99 0.40
M_ST45TA 27.30 3.23e+06 7.17e+11 1.59e+17 0.620 0.852 0.872 0.608 0.852 0.870 0.0337 0.571 4.25 7.03 0.10
M_ST38TA 48.21 1.74e+11 8.63e+20 4.29e+30 0.582 0.848 0.869 0.583 0.847 0.864 0.0329 0.595 4.20 7.35 0.10
M_ST43TS 637.16 2.32e+148 5.21e+276 Inf 0.543 0.892 0.900 0.537 0.890 0.899 0.0299 0.570 4.12 7.09 0.95
M_ST39CV 3.27 5.58e+00 2.62e+01 1.23e+02 0.580 0.867 0.896 0.577 0.867 0.899 0.0254 0.263 4.11 3.11 0.10
M_ST24TS 77.78 3.74e+16 5.99e+33 9.61e+50 0.620 0.888 0.896 0.621 0.884 0.895 0.0200 0.254 3.75 3.00 0.45
M_ST59SA -10.02 2.63e-07 4.47e-05 7.59e-03 0.560 0.897 0.900 0.567 0.895 0.900 0.0243 0.342 3.72 4.09 0.65
pander::pander(bDXmlNLDE$univariate[bDXmlNLDE$selectedfeatures,])
  Name RName ZUni
RD_ST32TA RD_ST32TA RD_ST32TA 8.21
Hippocampus Hippocampus Hippocampus 17.66
M_ST24TA M_ST24TA M_ST24TA 17.25
M_ST43TS M_ST43TS M_ST43TS 1.92
M_ST59SA M_ST59SA M_ST59SA 4.00
M_ST12SV M_ST12SV M_ST12SV 16.99
M_ST24CV M_ST24CV M_ST24CV 16.30
RD_ST55TA RD_ST55TA RD_ST55TA 2.87
M_ST40CV M_ST40CV M_ST40CV 13.21
M_ST60CV M_ST60CV M_ST60CV 6.61
M_ST24TS M_ST24TS M_ST24TS 5.70
M_ST60SA M_ST60SA M_ST60SA 2.80
M_ST39CV M_ST39CV M_ST39CV 4.03
M_ST51CV M_ST51CV M_ST51CV 4.19
M_ST44CV M_ST44CV M_ST44CV 11.50
M_ST32CV M_ST32CV M_ST32CV 13.38
M_ST31TA M_ST31TA M_ST31TA 10.24
RD_ST40TA RD_ST40TA RD_ST40TA 6.46
M_ST30SV M_ST30SV M_ST30SV 12.46
M_ST43TA M_ST43TA M_ST43TA 3.44
M_ST60TS M_ST60TS M_ST60TS 4.77
M_ST62TA M_ST62TA M_ST62TA 3.95
M_ST47TS M_ST47TS M_ST47TS 2.35
M_ST40TA M_ST40TA M_ST40TA 12.66
Ventricles Ventricles Ventricles 7.49
M_ST38TA M_ST38TA M_ST38TA 5.42
M_ST45TA M_ST45TA M_ST45TA 4.90
M_ST11SV M_ST11SV M_ST11SV 5.06
M_ST13TA M_ST13TA M_ST13TA 10.40

prBin <- predictionStats_binary(cbind(TADPOLE_DX_NLDE_TEST$DX,predict(bDXmlNLDE,TADPOLE_DX_NLDE_TEST)),"NL vs Dementia")

NL vs Dementia

pander::pander(prBin$aucs)
est lower upper
0.945 0.92 0.971
pander::pander(prBin$accc)
est lower upper
0.871 0.826 0.908
pander::pander(prBin$berror)
50% 2.5% 97.5%
0.136 0.0941 0.182
pander::pander(prBin$sensitivity)
est lower upper
0.837 0.748 0.904
par(op)

4.0.3 The formula network

cmax <- apply(bDXmlNLDE$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.25])
cmax <- cmax[cnames]

adma <- bDXmlNLDE$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=10*E(gr)$weight,
     vertex.size=10*cmax,
     vertex.label.cex=0.75,
     vertex.label.dist=0,
     main="NL vs Dementia Diagnosis")

par(op)

4.0.4 NL vs Dementia table


clusterFeatures <- fc$names
sm$coefficients$DeltaAUC <- (sm$coefficients$full.AUC-sm$coefficients$r.AUC)

tableNL_DE <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "OR",
                                     "upper",
                                     "full.AUC",
                                     "DeltaAUC",
                                     "z.IDI",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableNL_DE$Cluster <- nugget[rownames(tableNL_DE)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableNL_DE$Description <- description[rownames(tableNL_DE)]
pander::pander(tableNL_DE)
  Estimate lower OR upper full.AUC DeltaAUC z.IDI Frequency Cluster Description
RD_ST32TA 13.02 1.27e+04 4.49e+05 1.59e+07 0.899 0.03591 6.82 1.00 1 Cortical Thickness Average of LeftInferiorTemporal
Hippocampus -81.07 8.64e-45 6.17e-36 4.40e-27 0.899 0.03152 6.83 1.00 1 NA
M_ST24TA -159.96 2.93e-90 3.39e-70 3.92e-50 0.899 0.02604 6.41 1.00 1 Cortical Thickness Average of LeftEntorhinal
M_ST43TS 637.16 2.32e+148 5.21e+276 Inf 0.899 0.00982 4.12 0.95 1 Cortical Thickness Standard Deviation of LeftParacentral
M_ST59SA -10.02 2.63e-07 4.47e-05 7.59e-03 0.900 0.00494 3.72 0.65 1 Surface Area of LeftSupramarginal
M_ST12SV -46.93 8.03e-27 4.17e-21 2.17e-15 0.886 0.02540 5.92 0.65 2 Volume (WM Parcellation) of LeftAmygdala
M_ST24CV -38.45 5.48e-23 2.00e-17 7.31e-12 0.887 0.02128 5.82 0.65 2 Volume (Cortical Parcellation) of LeftEntorhinal
M_ST40CV -29.80 2.58e-19 1.15e-13 5.12e-08 0.889 0.01966 4.37 0.60 2 Volume (Cortical Parcellation) of LeftMiddleTemporal
M_ST24TS 77.78 3.74e+16 5.99e+33 9.61e+50 0.895 0.01043 3.75 0.45 2 Cortical Thickness Standard Deviation of LeftEntorhinal
M_ST51CV 13.08 4.76e+03 4.78e+05 4.80e+07 0.898 0.03077 5.49 0.30 2 Volume (Cortical Parcellation) of LeftPrecentral
M_ST44CV -52.54 7.80e-31 1.53e-23 3.00e-16 0.868 0.02959 6.04 0.40 3 Volume (Cortical Parcellation) of LeftParahippocampal
M_ST32CV -19.49 2.61e-12 3.43e-09 4.50e-06 0.868 0.02203 5.24 0.30 3 Volume (Cortical Parcellation) of LeftInferiorTemporal
M_ST31TA -112.71 1.85e-70 1.13e-49 6.85e-29 0.890 0.01511 4.48 0.40 2 Cortical Thickness Average of LeftInferiorParietal
RD_ST40TA 3.18 5.94e+00 2.40e+01 9.72e+01 0.869 0.01772 4.27 0.40 3 Cortical Thickness Average of LeftMiddleTemporal
M_ST30SV 21.54 1.69e+07 2.26e+09 3.01e+11 0.868 0.03185 7.11 0.40 3 Volume (WM Parcellation) of LeftInferiorLateralVentricle
M_ST62TA 79.35 5.72e+19 2.88e+34 1.45e+49 0.869 0.01307 4.43 0.30 3 Cortical Thickness Average of LeftTransverseTemporal
M_ST11SV 140.83 4.57e+36 1.45e+61 4.61e+85 0.870 0.01658 4.72 0.25 3 Volume (WM Parcellation) of LeftAccumbensArea

4.1 Decorrelated Set

TADPOLE_DX_NLDE_TRAIND <- GDSTMDecorrelation(TADPOLE_DX_NLDE_TRAIN,Outcome="DX",
                                        thr=0.6,
                                        type="RLM",
                                        method="spearman",
                                        verbose = TRUE)
#> 
#>  Included: 194 , Uni p: 0.0110018 To Outcome: 109 , Base: 5 , In Included: 5 , Base Cor: 18 
#> 1 , Top: 40 < 0.6 >( 2 )[ 1 : 0 : 0.594 ]( 40 , 83 , 0 ),<>Tot Used: 123 , Added: 83 , Zero Std: 0 , Max Cor: 0.9669697 
#> 2 , Top: 17 < 0.6 >( 1 )[ 1 : 0 : 0.594 ]( 16 , 28 , 40 ),<>Tot Used: 140 , Added: 28 , Zero Std: 0 , Max Cor: 0.9627667 
#> 3 , Top: 15 < 0.6 >[ FALSE ]( 1 )[ 1 : 0 : 0.594 ]( 14 , 22 , 52 ),<>Tot Used: 152 , Added: 22 , Zero Std: 0 , Max Cor: 0.9130056 
#> 4 , Top: 14 < 0.6 >( 1 )[ 1 : 0 : 0 ]( 13 , 14 , 62 ),<>Tot Used: 162 , Added: 14 , Zero Std: 0 , Max Cor: 0.9517803 
#> 5 , Top: 5 < 0.6 >( 1 )[ 1 : 0 : 0 ]( 5 , 5 , 72 ),<>Tot Used: 164 , Added: 5 , Zero Std: 0 , Max Cor: 0.8156711 
#> 6 , Top: 1 < 0.6 >( 1 )[ 1 : 0 : 0.6 ]( 1 , 1 , 76 ),<>Tot Used: 164 , Added: 1 , Zero Std: 0 , Max Cor: 0.5978659 
#> [ 7 ], 0.5978659 . Cor to Base: 91 , ABase: 65
TADPOLE_DX_NLDE_TESTD <-  predictDecorrelate(TADPOLE_DX_NLDE_TRAIND,TADPOLE_DX_NLDE_TEST)

4.1.1 Learning



bDXmlNLDED <- BSWiMS.model(DX~.,TADPOLE_DX_NLDE_TRAIND,NumberofRepeats = 20)

[+++-++-++-+++-++–++-++-++-++-++-++-+++-++-+++-++-++-+++-++-++-++-]….

pander::pander(bDXmlNLDED$bagging$Jaccard.SM)

0.294


fs <- bDXmlNLDED$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bDXmlNLDED)
pander::pander(sm$coefficients)
  Estimate lower OR upper u.Accuracy r.Accuracy full.Accuracy u.AUC r.AUC full.AUC IDI NRI z.IDI z.NRI Frequency
Ba_Hippocampus -111.406 6.16e-56 4.14e-49 2.79e-42 0.822 0.714 0.905 0.816 0.701 0.901 0.4362 1.457 21.23 25.11 1.00
M_ST44SA -42.442 9.26e-22 3.69e-19 1.48e-16 0.569 0.789 0.877 0.572 0.787 0.874 0.2176 1.169 12.72 16.93 0.25
De_M_ST44CV 109.399 1.65e+40 3.25e+47 6.40e+54 0.555 0.815 0.881 0.549 0.812 0.877 0.1634 0.964 10.55 13.45 0.30
M_ST44TA -292.362 3.07e-156 1.07e-127 3.72e-99 0.703 0.821 0.895 0.697 0.816 0.891 0.1492 0.806 9.74 11.33 0.90
Ba_M_ST31TA -316.526 1.01e-165 3.42e-138 1.16e-110 0.706 0.850 0.898 0.699 0.847 0.895 0.1167 0.910 8.36 12.26 1.00
De_M_ST32CV -27.349 1.66e-15 1.33e-12 1.06e-09 0.575 0.864 0.898 0.580 0.858 0.894 0.0745 0.646 7.07 7.96 0.15
De_M_ST51TA 752.294 5.11e+248 Inf Inf 0.626 0.881 0.905 0.609 0.878 0.901 0.0810 0.691 6.82 8.80 1.00
De_M_ST24TA -123.451 1.73e-70 2.43e-54 3.43e-38 0.626 0.880 0.905 0.619 0.875 0.901 0.0594 0.641 6.29 8.01 1.00
De_M_ST58CV 195.220 3.96e+59 6.07e+84 9.30e+109 0.675 0.869 0.898 0.674 0.863 0.895 0.0613 0.732 6.05 9.29 1.00
De_M_ST32TA 63.144 4.41e+17 2.65e+27 1.59e+37 0.548 0.873 0.898 0.547 0.866 0.894 0.0481 0.625 5.47 7.69 0.15
De_Ventricles 138.846 6.31e+37 2.00e+60 6.31e+82 0.726 0.882 0.898 0.711 0.879 0.895 0.0405 0.472 5.14 5.79 1.00
De_M_ST24CV -22.826 2.14e-14 1.22e-10 6.96e-07 0.612 0.858 0.878 0.610 0.858 0.874 0.0414 0.485 5.11 5.93 0.20
De_M_ST38TA 172.712 2.96e+46 1.02e+75 3.51e+103 0.572 0.871 0.889 0.560 0.868 0.885 0.0439 0.507 5.02 6.17 0.30
RD_ST32TA 6.508 5.65e+01 6.71e+02 7.96e+03 0.684 0.886 0.903 0.667 0.882 0.899 0.0402 0.590 5.02 7.26 1.00
De_M_ST13TA -68.702 4.38e-42 1.46e-30 4.84e-19 0.575 0.868 0.889 0.570 0.862 0.886 0.0404 0.612 4.96 7.60 0.20
M_ST44TS -75.292 1.40e-46 2.00e-33 2.85e-20 0.524 0.867 0.889 0.533 0.864 0.886 0.0345 0.672 4.80 8.41 0.20
Ba_M_ST32SA -9.750 9.62e-07 5.83e-05 3.53e-03 0.678 0.880 0.898 0.669 0.874 0.895 0.0303 0.485 4.48 5.91 1.00
RD_ST15TA 4.170 9.76e+00 6.47e+01 4.29e+02 0.598 0.894 0.905 0.569 0.890 0.901 0.0276 0.433 4.21 5.34 0.60
RD_ST40TA 6.239 3.01e+01 5.13e+02 8.74e+03 0.631 0.886 0.898 0.607 0.882 0.894 0.0303 0.449 4.20 5.48 0.60
De_M_ST12SV -11.916 2.71e-08 6.68e-06 1.65e-03 0.558 0.871 0.884 0.564 0.866 0.881 0.0242 0.357 4.19 4.27 0.10
De_M_ST43TA 215.897 3.54e+49 5.79e+93 9.49e+137 0.593 0.886 0.896 0.591 0.884 0.893 0.0305 0.496 3.97 6.05 0.90
RD_ST47TS -0.485 4.78e-01 6.15e-01 7.92e-01 0.509 0.878 0.892 0.530 0.873 0.885 0.0156 0.328 3.73 3.92 0.10
Ba_M_ST59SA -4.561 8.52e-04 1.05e-02 1.28e-01 0.561 0.900 0.902 0.569 0.892 0.899 0.0210 0.296 3.46 3.52 0.60
pander::pander(bDXmlNLDED$univariate[bDXmlNLDED$selectedfeatures,])
  Name RName ZUni
Ba_Hippocampus Ba_Hippocampus Ba_Hippocampus 17.66
De_M_ST51TA De_M_ST51TA De_M_ST51TA 6.49
De_M_ST24TA De_M_ST24TA De_M_ST24TA 5.33
RD_ST15TA RD_ST15TA RD_ST15TA 3.62
Ba_M_ST31TA Ba_M_ST31TA Ba_M_ST31TA 10.24
RD_ST32TA RD_ST32TA RD_ST32TA 8.21
De_Ventricles De_Ventricles De_Ventricles 9.48
De_M_ST58CV De_M_ST58CV De_M_ST58CV 8.26
Ba_M_ST32SA Ba_M_ST32SA Ba_M_ST32SA 8.14
RD_ST40TA RD_ST40TA RD_ST40TA 6.46
De_M_ST32CV De_M_ST32CV De_M_ST32CV 3.00
M_ST44TS M_ST44TS M_ST44TS 1.69
M_ST44TA M_ST44TA M_ST44TA 9.64
Ba_M_ST59SA Ba_M_ST59SA Ba_M_ST59SA 4.00
De_M_ST13TA De_M_ST13TA De_M_ST13TA 3.47
De_M_ST32TA De_M_ST32TA De_M_ST32TA 2.99
De_M_ST43TA De_M_ST43TA De_M_ST43TA 4.78
De_M_ST38TA De_M_ST38TA De_M_ST38TA 2.22
De_M_ST44CV De_M_ST44CV De_M_ST44CV 2.53
M_ST44SA M_ST44SA M_ST44SA 3.82
De_M_ST12SV De_M_ST12SV De_M_ST12SV 3.31
De_M_ST24CV De_M_ST24CV De_M_ST24CV 5.21
RD_ST47TS RD_ST47TS RD_ST47TS 1.88
De_M_ST40CV De_M_ST40CV De_M_ST40CV 3.80
De_M_ST45TA De_M_ST45TA De_M_ST45TA 2.89

prBin <- predictionStats_binary(cbind(TADPOLE_DX_NLDE_TESTD$DX,predict(bDXmlNLDED,TADPOLE_DX_NLDE_TESTD)),"NL vs Dementia")

NL vs Dementia

pander::pander(prBin$aucs)
est lower upper
0.951 0.925 0.977
pander::pander(prBin$accc)
est lower upper
0.882 0.838 0.917
pander::pander(prBin$berror)
50% 2.5% 97.5%
0.118 0.0803 0.16
pander::pander(prBin$sensitivity)
est lower upper
0.878 0.796 0.935
par(op)

4.1.2 The formula network

cmax <- apply(bDXmlNLDED$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.25])
cmax <- cmax[cnames]

adma <- bDXmlNLDED$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=10*E(gr)$weight,
     vertex.size=10*cmax,
     vertex.label.cex=0.75,
     vertex.label.dist=0,
     main="NL vs Dementia Diagnosis")

par(op)

4.1.3 Decorrelated NL vs Dementia table


clusterFeatures <- fc$names
sm$coefficients$DeltaAUC <- (sm$coefficients$full.AUC-sm$coefficients$r.AUC)

tableNL_DED <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "OR",
                                     "upper",
                                     "full.AUC",
                                     "DeltaAUC",
                                     "z.IDI",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableNL_DED$Cluster <- nugget[rownames(tableNL_DED)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
rnames <- str_replace_all(rnames,"Ba_","")
rnames <- str_replace_all(rnames,"De_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableNL_DED$Description <- description[rownames(tableNL_DED)]



## Getting the decorrelation formula
dc <- getDerivedCoefficients(TADPOLE_DX_NLDE_TRAIND)
decornames <- rownames(sm$coefficients)

deNames_in_dc <- decornames[decornames %in% names(dc)]
theDeFormulas <- dc[deNames_in_dc]
deFromula <- character(length(theDeFormulas))
names(deFromula) <- names(theDeFormulas)
for (dx in names(deFromula))
{
  coef <- theDeFormulas[[dx]]
  cname <- names(theDeFormulas[[dx]])
  names(cname) <- cname
  for (cf in names(coef))
  {
    if (cf != dx)
    {
      if (coef[cf]>0)
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("+ %5.3f*%s",coef[cf],cname[cf]))
      }
      else
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("%5.3f*%s",coef[cf],cname[cf]))
      }
    }
  }
}

tableNL_DED$DecorFormula <- deFromula[rownames(tableNL_DED)]



pander::pander(tableNL_DED)
  Estimate lower OR upper full.AUC DeltaAUC z.IDI Frequency Cluster Description DecorFormula
Ba_Hippocampus -111.41 6.16e-56 4.14e-49 2.79e-42 0.901 0.20002 21.23 1.00 1 NA NA
De_M_ST51TA 752.29 5.11e+248 Inf Inf 0.901 0.02285 6.82 1.00 1 Cortical Thickness Average of LeftPrecentral -0.507M_ST31TA + 1.000M_ST51TA + 0.032M_ST51SA -0.140M_ST51CV
De_M_ST24TA -123.45 1.73e-70 2.43e-54 3.43e-38 0.901 0.02584 6.29 1.00 1 Cortical Thickness Average of LeftEntorhinal -0.324Hippocampus + 1.000M_ST24TA
RD_ST15TA 4.17 9.76e+00 6.47e+01 4.29e+02 0.901 0.01102 4.21 0.60 1 Cortical Thickness Average of LeftCaudalMiddleFrontal NA
Ba_M_ST31TA -316.53 1.01e-165 3.42e-138 1.16e-110 0.895 0.04809 8.36 1.00 2 Cortical Thickness Average of LeftInferiorParietal NA
RD_ST32TA 6.51 5.65e+01 6.71e+02 7.96e+03 0.899 0.01711 5.02 1.00 2 Cortical Thickness Average of LeftInferiorTemporal NA
De_Ventricles 138.85 6.31e+37 2.00e+60 6.31e+82 0.895 0.01522 5.14 1.00 2 NA + 1.000Ventricles -1.285M_ST37SV
De_M_ST58CV 195.22 3.96e+59 6.07e+84 9.30e+109 0.895 0.03127 6.05 1.00 2 Volume (Cortical Parcellation) of LeftSuperiorTemporal -0.125Hippocampus -2.854M_ST58TA -0.212M_ST58SA + 1.000M_ST58CV
Ba_M_ST32SA -9.75 9.62e-07 5.83e-05 3.53e-03 0.895 0.02019 4.48 1.00 2 Surface Area of LeftInferiorTemporal NA
RD_ST40TA 6.24 3.01e+01 5.13e+02 8.74e+03 0.894 0.01181 4.20 0.60 1 Cortical Thickness Average of LeftMiddleTemporal NA
M_ST44TA -292.36 3.07e-156 1.07e-127 3.72e-99 0.891 0.07512 9.74 0.90 2 Cortical Thickness Average of LeftParahippocampal NA
Ba_M_ST59SA -4.56 8.52e-04 1.05e-02 1.28e-01 0.899 0.00683 3.46 0.60 2 Surface Area of LeftSupramarginal NA
De_M_ST43TA 215.90 3.54e+49 5.79e+93 9.49e+137 0.893 0.00880 3.97 0.90 2 Cortical Thickness Average of LeftParacentral -0.708M_ST31TA + 1.000M_ST43TA
De_M_ST38TA 172.71 2.96e+46 1.02e+75 3.51e+103 0.885 0.01643 5.02 0.30 3 Cortical Thickness Average of LeftLingual -0.550M_ST31TA + 1.000M_ST38TA
De_M_ST44CV 109.40 1.65e+40 3.25e+47 6.40e+54 0.877 0.06500 10.55 0.30 3 Volume (Cortical Parcellation) of LeftParahippocampal -0.380Hippocampus + 1.000M_ST44CV
M_ST44SA -42.44 9.26e-22 3.69e-19 1.48e-16 0.874 0.08626 12.72 0.25 3 Surface Area of LeftParahippocampal NA

5 Prognosis MCI to AD Conversion

5.1 the set

TrainFraction <- 0.60;

MCIPrognosisIDs <- c(MCIconverters$PTID,MCI_No_converters$PTID)

TADPOLECrossMRI <- validBaselineTadpole[MCIPrognosisIDs,]
table(TADPOLECrossMRI$DX)

Dementia MCI NL 0 680 0

TADPOLECrossMRI$DX <- NULL
TADPOLECrossMRI$status <- 1*(rownames(TADPOLECrossMRI) %in% MCIconverters$PTID)
table(TADPOLECrossMRI$status)

0 1 436 244

TADPOLECrossMRI$TimeToEvent <- numeric(nrow(TADPOLECrossMRI))
TADPOLECrossMRI[MCIconverters$PTID,"TimeToEvent"] <- MCIconverters$TimeToEvent
TADPOLECrossMRI[MCI_No_converters$PTID,"TimeToEvent"] <- MCI_No_converters$TimeToEvent

TADPOLE_Cases <- subset(TADPOLECrossMRI,status==1)
TADPOLE_Controls <- subset(TADPOLECrossMRI,status==0)
trainCasesSet <- sample(nrow(TADPOLE_Cases),nrow(TADPOLE_Cases)*TrainFraction)
trainControlSet <- sample(nrow(TADPOLE_Controls),nrow(TADPOLE_Controls)*TrainFraction)

TADPOLE_Conv_TRAIN <- rbind(TADPOLE_Cases[trainCasesSet,],TADPOLE_Controls[trainControlSet,])
TADPOLE_Conv_TEST <- TADPOLECrossMRI[!(rownames(TADPOLECrossMRI) %in%
                                         rownames(TADPOLE_Conv_TRAIN)),]

pander::pander(table(TADPOLE_Conv_TRAIN$status))
0 1
261 146
pander::pander(table(TADPOLE_Conv_TEST$status))
0 1
175 98
par(op)

5.1.1 Learning

bConvml <- BSWiMS.model(Surv(TimeToEvent,status)~1,TADPOLE_Conv_TRAIN,NumberofRepeats = 20)

[++-+++-++-++-+–+–+–+++-++-++–++-+++-+–++-+–++-++-++-+–+–]…

pander::pander(bConvml$bagging$Jaccard.SM)

0.267


fs <- bConvml$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bConvml)
pander::pander(sm$coefficients)
  Estimate lower HR upper u.Accuracy r.Accuracy full.Accuracy u.AUC r.AUC full.AUC IDI NRI z.IDI z.NRI Frequency
FAQ 0.06129 1.05e+00 1.06e+00 1.08e+00 0.732 0.736 0.772 0.701 0.742 0.774 0.03870 0.500 6.51 6.15 1.00
M_ST12SV -5.66104 6.27e-04 3.48e-03 1.93e-02 0.678 0.700 0.725 0.675 0.701 0.727 0.04227 0.524 6.42 6.23 0.15
ADAS13 0.06511 1.05e+00 1.07e+00 1.09e+00 0.702 0.749 0.772 0.698 0.755 0.774 0.04813 0.401 5.86 4.74 1.00
RD_ST24CV 0.63042 1.49e+00 1.88e+00 2.37e+00 0.599 0.771 0.775 0.575 0.770 0.774 0.01450 0.372 5.21 4.39 0.20
ADAS11 0.02930 1.02e+00 1.03e+00 1.04e+00 0.676 0.714 0.740 0.667 0.718 0.739 0.04093 0.389 5.09 4.59 0.65
M_ST29SV -18.49681 7.10e-12 9.27e-09 1.21e-05 0.666 0.751 0.756 0.671 0.748 0.757 0.02289 0.368 4.98 4.30 0.95
M_ST13TA -21.98696 6.17e-14 2.83e-10 1.30e-06 0.669 0.725 0.736 0.667 0.729 0.739 0.03067 0.371 4.92 4.37 0.20
RD_ST25TA -0.30414 6.49e-01 7.38e-01 8.39e-01 0.494 0.775 0.775 0.511 0.775 0.776 0.00806 0.254 4.45 2.97 0.20
M_ST40SA -0.36302 5.88e-01 6.96e-01 8.22e-01 0.632 0.713 0.732 0.627 0.714 0.733 0.01452 0.307 4.10 3.55 0.10
M_ST51TS 89.89985 5.20e+20 1.10e+39 2.35e+57 0.553 0.748 0.755 0.553 0.750 0.757 0.01205 0.348 4.08 4.05 0.45
RAVLT_immediate -0.02411 9.65e-01 9.76e-01 9.87e-01 0.658 0.781 0.772 0.677 0.781 0.774 0.01950 0.456 4.06 5.39 1.00
M_ST24CV -6.28493 1.02e-04 1.86e-03 3.41e-02 0.703 0.749 0.752 0.689 0.749 0.752 0.01131 0.256 4.02 2.99 0.60
RAVLT_perc_forgetting 0.00268 1.00e+00 1.00e+00 1.00e+00 0.638 0.736 0.740 0.652 0.730 0.739 0.02211 0.407 4.00 4.80 0.65
M_ST43TS 95.08098 1.37e+21 1.96e+41 2.81e+61 0.541 0.751 0.756 0.535 0.752 0.757 0.01060 0.299 3.84 3.47 0.60
M_ST40CV -7.85417 7.44e-06 3.88e-04 2.02e-02 0.699 0.741 0.755 0.682 0.741 0.755 0.01736 0.199 3.81 2.30 0.50
M_ST39SA -1.25517 1.55e-01 2.85e-01 5.24e-01 0.631 0.766 0.769 0.619 0.765 0.769 0.00993 0.366 3.78 4.29 0.35
MMSE -0.01820 9.73e-01 9.82e-01 9.91e-01 0.649 0.724 0.734 0.642 0.729 0.736 0.02320 0.423 3.68 5.00 0.20
RD_ST34CV -0.95013 2.33e-01 3.87e-01 6.41e-01 0.533 0.730 0.742 0.555 0.733 0.745 0.01588 0.332 3.61 3.89 0.20
RD_ST129TS -0.13012 8.19e-01 8.78e-01 9.41e-01 0.511 0.728 0.738 0.532 0.729 0.737 0.01408 0.264 3.61 3.09 0.10
pander::pander(bConvml$univariate[bConvml$selectedfeatures,])
  Name RName ZUni
ADAS13 ADAS13 ADAS13 10.41
FAQ FAQ FAQ 8.69
RAVLT_immediate RAVLT_immediate RAVLT_immediate 9.01
RD_ST24CV RD_ST24CV RD_ST24CV 3.38
RD_ST25TA RD_ST25TA RD_ST25TA 1.45
M_ST39SA M_ST39SA M_ST39SA 5.26
M_ST13CV M_ST13CV M_ST13CV 6.56
ADAS11 ADAS11 ADAS11 8.86
M_ST24CV M_ST24CV M_ST24CV 9.05
M_ST29SV M_ST29SV M_ST29SV 8.83
M_ST40CV M_ST40CV M_ST40CV 8.80
M_ST43TS M_ST43TS M_ST43TS 1.83
RAVLT_perc_forgetting RAVLT_perc_forgetting RAVLT_perc_forgetting 6.63
M_ST51TS M_ST51TS M_ST51TS 2.57
RD_ST49CV RD_ST49CV RD_ST49CV 1.87
M_ST40SA M_ST40SA M_ST40SA 5.80
M_ST31CV M_ST31CV M_ST31CV 7.34
M_ST12SV M_ST12SV M_ST12SV 8.86
M_ST13TA M_ST13TA M_ST13TA 7.36
RD_ST129TS RD_ST129TS RD_ST129TS 1.83
MMSE MMSE MMSE 5.83
RD_ST43TS RD_ST43TS RD_ST43TS 3.01
RD_ST34CV RD_ST34CV RD_ST34CV 1.79

ptestl <- predict(bConvml,TADPOLE_Conv_TEST,type="lp")
boxplot(ptestl~TADPOLE_Conv_TEST$status)

ptestr <- predict(bConvml,TADPOLE_Conv_TEST,type="risk")
eventCases <- subset(TADPOLE_Conv_TEST,status==1)
plot(1.0/ptestr[rownames(eventCases)]~eventCases$TimeToEvent)

pander::pander(cor.test(eventCases$TimeToEvent,1.0/ptestr[rownames(eventCases)],method="spearman"))
Spearman’s rank correlation rho: eventCases$TimeToEvent and 1/ptestr[rownames(eventCases)]
Test statistic P value Alternative hypothesis rho
91411 1.92e-05 * * * two.sided 0.417



perdsurv <- cbind(TADPOLE_Conv_TEST$TimeToEvent,
                  TADPOLE_Conv_TEST$status,
                  ptestl,
                  ptestr)
prSurv <- predictionStats_survival(perdsurv,"MCI to  AD Conversion")

pander::pander(prSurv$CIRisk)
median lower upper
0.835 0.799 0.871
pander::pander(prSurv$CILp)
median lower upper
0.852 0.804 0.894
pander::pander(prSurv$spearmanCI)
50% 2.5% 97.5%
0.418 0.231 0.581

prBin <- predictionStats_binary(cbind(TADPOLE_Conv_TEST$status,ptestl),"MCI to  AD Conversion")

MCI to AD Conversion

pander::pander(prBin$aucs)
est lower upper
0.852 0.807 0.897
pander::pander(prBin$CM.analysis$tab)
  Outcome + Outcome - Total
Test + 76 47 123
Test - 22 128 150
Total 98 175 273

par(op)

5.1.2 The formula network

cmax <- apply(bConvml$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.25])
cmax <- cmax[cnames]

adma <- bConvml$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=5*E(gr)$weight,
     vertex.size=20*cmax,
     vertex.label.cex=0.75,
     vertex.label.dist=0,
     main="MCI to Dementia Conversion")

par(op)

5.1.3 MCI to Dementia table


clusterFeatures <- fc$names
sm$coefficients$DeltaAUC <- (sm$coefficients$full.AUC-sm$coefficients$r.AUC)

tableMCI_to_Dem <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "HR",
                                     "upper",
                                     "full.AUC",
                                     "DeltaAUC",
                                     "z.IDI",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableMCI_to_Dem$Cluster <- nugget[rownames(tableMCI_to_Dem)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
rnames <- str_replace_all(rnames,"Ba_","")
rnames <- str_replace_all(rnames,"De_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableMCI_to_Dem$Description <- description[rownames(tableMCI_to_Dem)]
pander::pander(tableMCI_to_Dem)
  Estimate lower HR upper full.AUC DeltaAUC z.IDI Frequency Cluster Description
ADAS13 0.06511 1.05e+00 1.07e+00 1.09e+00 0.774 0.01847 5.86 1.00 1 NA
FAQ 0.06129 1.05e+00 1.06e+00 1.08e+00 0.774 0.03236 6.51 1.00 1 NA
RAVLT_immediate -0.02411 9.65e-01 9.76e-01 9.87e-01 0.774 -0.00720 4.06 1.00 1 NA
M_ST39SA -1.25517 1.55e-01 2.85e-01 5.24e-01 0.769 0.00427 3.78 0.35 1 Surface Area of LeftMedialOrbitofrontal
ADAS11 0.02930 1.02e+00 1.03e+00 1.04e+00 0.739 0.02100 5.09 0.65 2 NA
M_ST24CV -6.28493 1.02e-04 1.86e-03 3.41e-02 0.752 0.00366 4.02 0.60 1 Volume (Cortical Parcellation) of LeftEntorhinal
M_ST29SV -18.49681 7.10e-12 9.27e-09 1.21e-05 0.757 0.00955 4.98 0.95 2 Volume (WM Parcellation) of LeftHippocampus
M_ST40CV -7.85417 7.44e-06 3.88e-04 2.02e-02 0.755 0.01423 3.81 0.50 2 Volume (Cortical Parcellation) of LeftMiddleTemporal
M_ST43TS 95.08098 1.37e+21 1.96e+41 2.81e+61 0.757 0.00458 3.84 0.60 2 Cortical Thickness Standard Deviation of LeftParacentral
RAVLT_perc_forgetting 0.00268 1.00e+00 1.00e+00 1.00e+00 0.739 0.00901 4.00 0.65 2 NA
M_ST51TS 89.89985 5.20e+20 1.10e+39 2.35e+57 0.757 0.00694 4.08 0.45 2 Cortical Thickness Standard Deviation of LeftPrecentral

5.2 Decorrelated

TADPOLE_Conv_TRAIND <- GDSTMDecorrelation(TADPOLE_Conv_TRAIN,
                                          Outcome="status",
                                          thr=0.6,
                                          type="RLM",
                                          method="spearman",
                                          verbose = TRUE)
#> 
#>  Included: 203 , Uni p: 0.01172495 To Outcome: 103 , Base: 3 , In Included: 3 , Base Cor: 3 
#> 1 , Top: 45 < 0.6 >( 2 )[ 1 : 0 : 0.594 ]( 43 , 98 , 0 ),<>Tot Used: 141 , Added: 98 , Zero Std: 0 , Max Cor: 0.9507145 
#> 2 , Top: 24 < 0.6 >[ FALSE ]( 1 )[ 1 : 0 : 0.594 ]( 22 , 35 , 43 ),<>Tot Used: 162 , Added: 35 , Zero Std: 0 , Max Cor: 0.8978966 
#> 3 , Top: 22 < 0.6 >( 2 )[ 1 : 0 : 0 ]( 21 , 25 , 62 ),<>Tot Used: 168 , Added: 25 , Zero Std: 0 , Max Cor: 0.9199215 
#> 4 , Top: 9 < 0.6 >[ FALSE ]( 1 )[ 1 : 0 : 0 ]( 9 , 9 , 77 ),<>Tot Used: 168 , Added: 9 , Zero Std: 0 , Max Cor: 0.8275661 
#> 5 , Top: 1 < 0.6 >[ FALSE ]( 1 )[ 1 : 0 : 0.6 ]( 1 , 1 , 83 ),<>Tot Used: 169 , Added: 1 , Zero Std: 0 , Max Cor: 0.5981195 
#> [ 6 ], 0.5952519 . Cor to Base: 107 , ABase: 69
TADPOLE_Conv_TESTD <-  predictDecorrelate(TADPOLE_Conv_TRAIND,TADPOLE_Conv_TEST)

5.2.1 Learning

bConvmlD <- BSWiMS.model(Surv(TimeToEvent,status)~1,TADPOLE_Conv_TRAIND,NumberofRepeats = 20)

[+–+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-]..

pander::pander(bConvmlD$bagging$Jaccard.SM)

0.579


fs <- bConvmlD$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bConvmlD)
pander::pander(sm$coefficients)
  Estimate lower HR upper u.Accuracy r.Accuracy full.Accuracy u.AUC r.AUC full.AUC IDI NRI z.IDI z.NRI Frequency
Ba_ADAS13 0.1230 1.11e+00 1.13e+00 1.16e+00 0.702 0.741 0.772 0.698 0.737 0.774 0.09878 0.6188 8.362 7.466 1.00
FAQ 0.0999 1.08e+00 1.11e+00 1.13e+00 0.732 0.738 0.772 0.702 0.741 0.774 0.04870 0.5739 7.443 7.154 1.00
Ba_Hippocampus -29.1994 1.80e-18 2.08e-13 2.41e-08 0.660 0.767 0.772 0.667 0.764 0.774 0.02331 0.4220 4.794 4.952 0.95
RD_ST24CV 0.1424 1.09e+00 1.15e+00 1.22e+00 0.600 0.768 0.773 0.575 0.763 0.770 0.00878 0.2682 4.560 3.130 0.05
De_M_ST13TA -135.3800 3.95e-85 1.60e-59 6.51e-34 0.609 0.769 0.776 0.606 0.774 0.778 0.02280 0.4613 4.426 5.436 0.50
De_M_ST25CV 60.8165 1.60e+15 2.58e+26 4.16e+37 0.554 0.777 0.774 0.550 0.778 0.776 0.01309 0.2641 4.365 3.066 0.65
De_ADAS11 -0.0347 9.51e-01 9.66e-01 9.81e-01 0.543 0.785 0.779 0.547 0.782 0.781 0.01292 0.4015 4.221 4.703 0.25
De_M_ST51TS 111.1803 1.83e+25 1.93e+48 2.04e+71 0.498 0.770 0.767 0.498 0.773 0.770 0.01086 0.2769 4.020 3.208 0.25
De_M_ST39CV -1.3250 1.33e-01 2.66e-01 5.30e-01 0.641 0.773 0.773 0.634 0.765 0.770 0.01408 0.3244 3.450 3.782 0.05
De_RAVLT_immediate -0.0136 9.79e-01 9.86e-01 9.94e-01 0.558 0.781 0.770 0.560 0.781 0.773 0.01596 0.4163 3.412 4.922 0.45
M_ST43TS 80.5135 6.91e+15 9.26e+34 1.24e+54 0.541 0.772 0.773 0.536 0.770 0.774 0.00982 0.2967 3.375 3.443 0.30
RD_ST25TA -0.0641 8.83e-01 9.38e-01 9.96e-01 0.500 0.773 0.773 0.497 0.769 0.770 0.00372 -0.0102 0.382 -0.127 0.05
pander::pander(bConvmlD$univariate[bConvmlD$selectedfeatures,])
  Name RName ZUni
Ba_ADAS13 Ba_ADAS13 Ba_ADAS13 10.41
FAQ FAQ FAQ 8.69
Ba_Hippocampus Ba_Hippocampus Ba_Hippocampus 8.46
RD_ST24CV RD_ST24CV RD_ST24CV 3.38
De_M_ST39CV De_M_ST39CV De_M_ST39CV 6.01
De_M_ST51TS De_M_ST51TS De_M_ST51TS 1.53
De_RAVLT_immediate De_RAVLT_immediate De_RAVLT_immediate 2.45
De_ADAS11 De_ADAS11 De_ADAS11 1.50
De_M_ST25CV De_M_ST25CV De_M_ST25CV 4.06
RD_ST25TA RD_ST25TA RD_ST25TA 1.45
M_ST43TS M_ST43TS M_ST43TS 1.83
De_M_ST13TA De_M_ST13TA De_M_ST13TA 4.51

ptestl <- predict(bConvmlD,TADPOLE_Conv_TESTD,type="lp")
boxplot(ptestl~TADPOLE_Conv_TEST$status)

ptestr <- predict(bConvmlD,TADPOLE_Conv_TESTD,type="risk")
eventCases <- subset(TADPOLE_Conv_TEST,status==1)
plot(1.0/ptestr[rownames(eventCases)]~eventCases$TimeToEvent)

pander::pander(cor.test(eventCases$TimeToEvent,1.0/ptestr[rownames(eventCases)],method="spearman"))
Spearman’s rank correlation rho: eventCases$TimeToEvent and 1/ptestr[rownames(eventCases)]
Test statistic P value Alternative hypothesis rho
87071 4.44e-06 * * * two.sided 0.445



perdsurv <- cbind(TADPOLE_Conv_TEST$TimeToEvent,
                  TADPOLE_Conv_TEST$status,
                  ptestl,
                  ptestr)
prSurv <- predictionStats_survival(perdsurv,"MCI to  AD Conversion")

pander::pander(prSurv$CIRisk)
median lower upper
0.839 0.803 0.871
pander::pander(prSurv$CILp)
median lower upper
0.854 0.807 0.896
pander::pander(prSurv$spearmanCI)
50% 2.5% 97.5%
0.443 0.262 0.603

prBin <- predictionStats_binary(cbind(TADPOLE_Conv_TESTD$status,ptestl),"MCI to  AD Conversion")

MCI to AD Conversion

pander::pander(prBin$aucs)
est lower upper
0.854 0.809 0.899
pander::pander(prBin$CM.analysis$tab)
  Outcome + Outcome - Total
Test + 80 46 126
Test - 18 129 147
Total 98 175 273

par(op)

5.2.2 The formula network

cmax <- apply(bConvmlD$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.25])
cmax <- cmax[cnames]

adma <- bConvmlD$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=5*E(gr)$weight,
     vertex.size=20*cmax,
     vertex.label.cex=0.75,
     vertex.label.dist=0,
     main="MCI to Dementia Conversion")

par(op)

5.2.3 Decorrelated MCI to Dementia table


clusterFeatures <- fc$names
sm$coefficients$DeltaAUC <- (sm$coefficients$full.AUC-sm$coefficients$r.AUC)

tableMCI_to_DemD <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "HR",
                                     "upper",
                                     "full.AUC",
                                     "DeltaAUC",
                                     "z.IDI",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableMCI_to_DemD$Cluster <- nugget[rownames(tableMCI_to_DemD)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
rnames <- str_replace_all(rnames,"Ba_","")
rnames <- str_replace_all(rnames,"De_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableMCI_to_DemD$Description <- description[rownames(tableMCI_to_DemD)]


## Getting the decorrelation formula
dc <- getDerivedCoefficients(TADPOLE_Conv_TRAIND)
decornames <- rownames(sm$coefficients)

deNames_in_dc <- decornames[decornames %in% names(dc)]
theDeFormulas <- dc[deNames_in_dc]
deFromula <- character(length(theDeFormulas))
names(deFromula) <- names(theDeFormulas)
for (dx in names(deFromula))
{
  coef <- theDeFormulas[[dx]]
  cname <- names(theDeFormulas[[dx]])
  names(cname) <- cname
  for (cf in names(coef))
  {
    if (cf != dx)
    {
      if (coef[cf]>0)
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("+ %5.3f*%s",coef[cf],cname[cf]))
      }
      else
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("%5.3f*%s",coef[cf],cname[cf]))
      }
    }
  }
}

tableMCI_to_DemD$DecorFormula <- deFromula[rownames(tableMCI_to_DemD)]


pander::pander(tableMCI_to_DemD)
  Estimate lower HR upper full.AUC DeltaAUC z.IDI Frequency Cluster Description DecorFormula
Ba_ADAS13 0.1230 1.11e+00 1.13e+00 1.16e+00 0.774 0.037173 8.36 1.00 1 NA NA
FAQ 0.0999 1.08e+00 1.11e+00 1.13e+00 0.774 0.033366 7.44 1.00 1 NA NA
Ba_Hippocampus -29.1994 1.80e-18 2.08e-13 2.41e-08 0.774 0.009979 4.79 0.95 1 NA NA
De_M_ST51TS 111.1803 1.83e+25 1.93e+48 2.04e+71 0.770 -0.003077 4.02 0.25 1 Cortical Thickness Standard Deviation of LeftPrecentral -0.605M_ST15TS + 1.000M_ST51TS
De_RAVLT_immediate -0.0136 9.79e-01 9.86e-01 9.94e-01 0.773 -0.007865 3.41 0.45 1 NA + 0.971ADAS13 + 1.000RAVLT_immediate
De_ADAS11 -0.0347 9.51e-01 9.66e-01 9.81e-01 0.781 -0.000775 4.22 0.25 1 NA + 1.000ADAS11 -0.643ADAS13
De_M_ST25CV 60.8165 1.60e+15 2.58e+26 4.16e+37 0.776 -0.001914 4.36 0.65 1 Volume (Cortical Parcellation) of LeftFrontalPole -1.088M_ST25TA -0.287M_ST25SA + 1.000M_ST25CV -0.262M_ST39CV
M_ST43TS 80.5135 6.91e+15 9.26e+34 1.24e+54 0.774 0.003489 3.38 0.30 1 Cortical Thickness Standard Deviation of LeftParacentral NA
De_M_ST13TA -135.3800 3.95e-85 1.60e-59 6.51e-34 0.778 0.003874 4.43 0.50 1 Cortical Thickness Average of LeftBankssts + 1.000M_ST13TA -0.892M_ST59TA

5.2.4 Saving the enviroment

save.image("~/GitHub/BSWiMS/TADPOLE_BSWIMS_Results.RData")